I am working with some legacy Macros in Solidworks 2016 in the company for which I work. I do not have much API skills, but was wondering if I could get some help altering an existing Macro. The macro we use takes all parts with a specific 'work' tag and the creates a BOM and isometric display on the first page, then on each page after, gives views of each part to be created. I have a BOM that has a specific sort within it that I want to use (which is referenced in the Macro), but every time the Macro is run, the BOM is in a basic sort (not the one that I have as the 'saved sort'). Is there a way to get the macro to 'apply' the saved sort from the default BOM?
MAX PARTS DRAWINGS
Dim swApp As Object
'----------MODIFIED TO SORT BY WORK
'-------------LFL 05.22.2018
'added all vendor bypass, eliminated Buyout gate, and changed sub to boot from drawing file with good templates
'-------------LFL 8.17.2017
'correctly differentiates between parts and assemblies
'-------------LFL 5.20.2017
'---------------------------------------
'--------PART DRAWING AUTOMATION--------
'---------------------------------------
Sub main()
Dim swApp As SldWorks.SldWorks
Dim Ass As SldWorks.AssemblyDoc
Dim Comp() As Object
Dim swComp As SldWorks.Component2
Dim strFileName As String
Dim FileTyp As Integer
Dim countNum As Integer
Dim CompDoc As ModelDoc2
Dim CompDocFile As String
Dim CompDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim val As String
Dim valout As String
Dim bool As Boolean
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim PageNum As Integer
Dim PartNum As String
Dim PartLog() As String
Dim PartLogCount As Integer
Dim Z As Integer
Dim TestPartNum As String
Dim FailFlag As Boolean
Dim BoCheck As String
Dim BoLog() As String
Dim BoCount As Integer
Dim AssCount As Integer
Dim SkipCount As Integer
Dim ConfigLog() As String
Dim TestPartConfig As String
Dim ConfigInstance As String
Dim GoodComponents() As Object
Dim GoodComponentNames() As String
Dim GoodComp As SldWorks.Component2
Dim GoodCompCount As Integer
Dim orderedComponents() As Object
Dim orderedComponentNames() As String
Dim orderedComp As SldWorks.Component2
Dim orderedConfig As String
Dim OrderedFileName As String
Dim vConfig As String
Dim gateVar As String
Dim compVendor As String
Dim seedAss As Object
Dim pickedFile As String
'Const swFilterSting As String = "SW Files|*.sldprt; *.sldasm; *.slddrw|Parts|*.sldprt|Assemblies|*.sldasm|Drawings|*.slddrw|ALL FILES|*.*|"
Const swFilterSting As String = "Assemblies|*.sldasm"
Dim seedConfig As String
Dim drwDocName As String
Dim startTime As Double
Dim includeInitials As Integer
BoCount = 0
AssCount = 0
PartLogCount = 0
drwDocName = "default"
Set swApp = Application.SldWorks
'defines the drawing from beginning
Set Part = swApp.ActiveDoc
drwDocName = Part.GetTitle
'MsgBox (drwDocName)
pickedFile = swApp.GetOpenFileName("Select Assembly for Part Automation...", Empty, swFilterString, Empty, Empty, Empty)
seedConfig = InputBox("SPECIFY THE SEED CONFIGURATION FOR AUTOMATED PART SET - CASE SENSITIVE", "SEED CONFIGURATION", "*")
'gateVar = "STEEL CNC"
gateVar = InputBox("SPECIFY WORK FOR AUTOMATED PART SET - CASE SENSITIVE" & vbNewLine & vbNewLine & "KEY TO BYPASS GATE AND PRODUCE ALL PARTS: 'ALL'")
includeInitials = MsgBox("The WORK Gate is: " & gateVar & vbNewLine & vbNewLine & "1. Program Requires and open and empty excel spreadsheet" & vbNewLine & vbNewLine & "2. Program requires Coburn, or a similar animal, to be pet" & vbNewLine & vbNewLine & "3. Would you like feature initials to be included on drawing sheet tabs?", 4)
'-----msgbox yes no is style 4. Yes returns 6, No returns 7
'-----start procedure
startTime = Timer
'opens new file for seeding, "part" is still tied to drawing file.
Set Ass = swApp.OpenDoc6(pickedFile, 2, 0, "seedConfig", longstatus, longwarnings)
Comp = Ass.GetComponents(False)
SkipCount = 0
For i = 0 To UBound(Comp)
Set swComp = Comp(i)
Debug.Print "i= " & i
'-------suppression check
If (swComp.GetSuppression = 3) Or (swComp.GetSuppression = 2) And (swComp.IsEnvelope = False) Then
'---------
Set CompDoc = swComp.GetModelDoc
Set CompDocExt = CompDoc.Extension
strFileName = swComp.GetPathName
CompDocFile = CompDoc.GetPathName
FileTyp = CompDoc.GetType
PageNum = i + 2
'Debug.Print stringFileName
Debug.Print CompDocFile
If FileTyp = swDocPART Then ' swDocPART = 1 (declared as integer)
'MsgBox ("file is a PART" & vbNewLine & "File Name: " & strFileName & vbNewLine & "File Type Integer: " & FileTyp & vbNewLine & "Component Doc File Name: " & CompDocFile)
PartNum = Right(strFileName, 13)
PartNum = Left(PartNum, 6)
Debug.Print PartNum
BoCheck = Right(strFileName, 13)
BoCheck = Left(BoCheck, 2)
'-------------------------
'BO check removed--------
'If BoCheck = "BO" Then
'MsgBox ("buyOut Part #: BO " & PartNum & vbNewLine & vbNewLine & "SKIPPED")
'BoCount = BoCount + 1
'--------------------------
'Else
'----remove with BO if above
'-----added for vendor gate
vConfig = swComp.ReferencedConfiguration
Debug.Print vConfig
CompDoc.ShowConfiguration2 (vConfig)
Set swCustProp = CompDocExt.CustomPropertyManager("")
bool = swCustProp.Get4("WORK", False, val, valout)
compVendor = val
Debug.Print compVendor
If compVendor = gateVar Or gateVar = "ALL" Then
'----- see end if below
FailFlag = False
ReDim Preserve PartLog(PartLogCount)
PartLog(PartLogCount) = PartNum
ReDim Preserve ConfigLog(PartLogCount)
ConfigLog(PartLogCount) = swComp.ReferencedConfiguration
ConfigInstance = ConfigLog(PartLogCount)
If PartLogCount = 0 Then
Else
For Z = 0 To PartLogCount - 1
TestPartNum = PartLog(Z)
TestPartConfig = ConfigLog(Z)
If PartNum = TestPartNum And ConfigInstance = TestPartConfig Then
FailFlag = True
End If
'Debug.Print PartLog(PartLogCount)
Next
End If
If FailFlag = False Then
'Debug.Print PartLogCount
'Debug.Print PartNum
'Debug.Print ConfigInstance
ReDim Preserve GoodComponents(PartLogCount)
Set GoodComponents(PartLogCount) = Comp(i)
'GoodComponents(PartLogCount, 2) = PartNum
'GoodComponents(PartLogCount, 3) = ConfigInstance
PartLogCount = PartLogCount + 1
Debug.Print UBound(GoodComponents)
End If
'----added for vendor gate
End If
'-----vendor gate
'------removed to eliminate BO check
'End If
'--------bo check
End If
If FileTyp = swDocASSEMBLY Then ' swDocASSEMBLY = 2 (delcared as integer)
'MsgBox ("file is an ASSEMBLY" & vbNewLine & "File Name: " & strFileName & vbNewLine & "File Type Integer: " & FileTyp)
AssCount = AssCount + 1
End If
'added for suppression check
'-----------------------
Else
SkipCount = SkipCount + 1
End If
'-------- end added for suppression check
'------------
Next
'MsgBox ("BO Parts In Set: " & vbNewLine & vbNewLine & " " & BoCount & vbNewLine & vbNewLine & "Lightweight, Suppressed, and Envelope Components Skipped: " & vbNewLine & vbNewLine & " " & SkipCount & vbNewLine & vbNewLine & "Subassemblies in Master: " & vbNewLine & vbNewLine & " " & AssCount & vbNewLine & vbNewLine & "Components included in Part Set: " & UBound(GoodComponents) + 1)
'------------------------------------
'------------------------------------
'------------------------------------
'--------------EXCEL-----------------
Dim Row As Integer
' Attach to active Excel object
Set xl = GetObject(, "Excel.Application")
' Get active sheet in Excel
Set xlsh = xl.ActiveSheet
xlsh.Cells.Clear
For i = 0 To UBound(GoodComponents)
Set GoodComp = GoodComponents(i)
strFileName = GoodComp.GetPathName
PartNum = Right(strFileName, 13)
PartNum = Left(PartNum, 6)
ReDim Preserve PartLog(i)
PartLog(i) = PartNum
ReDim Preserve ConfigLog(i)
ConfigLog(i) = GoodComp.ReferencedConfiguration
ConfigInstance = ConfigLog(i)
Row = i + 1
xlsh.range("A" & Row).Value = PartNum
xlsh.range("B" & Row).Value = ConfigInstance
xlsh.range("c" & Row).Value = i
GoodComponentCount = GoodComponentCount + 1
Next
'MsgBox ("break line - sorted")
'---- need to expand range
xlsh.range("A1:C244").Sort Key1:=xlsh.range("A1:A244"), Header:=xlYes, Key2:=xlsh.range("B1:B244"), Header:=xlYes
Dim IndexOrder() As Integer
Dim SortedOrder() As Integer
Dim Sort As Integer
ReDim Preserve IndexOrder(UBound(GoodComponents))
ReDim Preserve orderedComponents(UBound(GoodComponents))
ReDim Preserve SortedOrder(UBound(GoodComponents))
For i = 0 To UBound(GoodComponents)
IndexOrder(i) = xlsh.Cells(i + 1, 3)
SortedOrder(i) = i
Next
For i = 0 To UBound(GoodComponents)
Sort = SortedOrder(i)
For j = 0 To UBound(GoodComponents)
If Sort = IndexOrder(j) Then
Set GoodComp = GoodComponents(i)
Set orderedComponents(j) = GoodComp
Debug.Print IndexOrder(i)
Debug.Print Sort
Debug.Print orderedComponents(j).GetPathName
Debug.Print " "
End If
Next
Next
'MsgBox ("Ordered Components QTY: " & UBound(orderedComponents) + 1 & vbNewLine & "Good Components QTY: " & UBound(GoodComponents) + 1)
'activate drawing again
swApp.ActivateDoc2 drwDocName, False, longstatus
'place drawing on cover
Dim myView As Object
'place drawing on cover
Set myView = Part.CreateDrawViewFromModelView3(pickedFile, "*Isometric", 0.098, 0.25, 0)
'Set swActiveView = Part.ActiveDrawingView
Dim swBOMTable As Object
Set swBOMTable = myView.InsertBomTable2(False, 9.52500000000001E-03, 0.220547524180041, swBOMConfigurationAnchorType_e.swBOMConfigurationAnchor_TopLeft, swBomType_e.swBomType_PartsOnly, seedConfig, "T:\Drafting Templates\SWX\TE SWX TEMPLATES 2018\BOM STANDARD 8.5 X 11 - 2018.sldbomtbt")
For y = 0 To UBound(GoodComponents)
Set orderedComp = orderedComponents(y)
orderedConfig = orderedComp.ReferencedConfiguration
OrderedFileName = orderedComp.GetPathName
'--- use this part number selector for shorter page tabs
'PartNum = Right(OrderedFileName, 10)
'PartNum = Left(PartNum, 3)
'------------------------
If includeInitials = 6 Then
PartNum = Right(OrderedFileName, 13)
PartNum = Left(PartNum, 6)
Else
PartNum = Right(OrderedFileName, 10)
PartNum = Left(PartNum, 3)
End If
Debug.Print orderedComp.GetPathName
'Debug.Print OrderedFileName
'------------
'--Make Sheets
'-----use reference from beginning
'Set Part = swApp.ActiveDoc
'-----use ref from beg - end
boolstatus = Part.NewSheet3(PartNum & " - " & orderedConfig, 0, 12, 1, 2, False, "t:\drafting templates\swx\te swx templates 2018\DRAWINGS - 2018\ANSI A - SHEET FORMAT - PD - 2018.slddrt", 0.1, 0.1, "Default")
boolstatus = Part.SetupSheet5(PartNum & " - " & orderedConfig, 12, 12, 1, 32, False, "t:\drafting templates\swx\te swx templates 2018\DRAWINGS - 2018\ANSI A - SHEET FORMAT - PD - 2018.slddrt", 0.2159, 0.2794, "Default", False)
'Dim myView As Object
Set myView = Part.CreateDrawViewFromModelView3(OrderedFileName, "*Front", 0.06, 0.1, 0)
'longstatus = Part.AutoDimension(1, 2, -1, 2, 1)
Set myView = Part.CreateDrawViewFromModelView3(OrderedFileName, "*Right", 0.16, 0.1, 0)
'longstatus = Part.AutoDimension(1, 2, -1, 2, 1)
Set myView = Part.CreateDrawViewFromModelView3(OrderedFileName, "*Top", 0.06, 0.2, 0)
'longstatus = Part.AutoDimension(1, 2, -1, 2, 1)
Set myView = Part.CreateDrawViewFromModelView3(OrderedFileName, "*Isometric", 0.16, 0.2, 0)
boolstatus = Part.ChangeRefConfigurationOfFlatPatternView(OrderedFileName, orderedConfig)
'boolstatus = Part.ActivateView("Drawing View1")
'----------------
'----------------
'----------------
Next
boolstatus = Part.Extension.LoadDraftingStandard("T:\Drafting Templates\SWX\TE SWX TEMPLATES 2018\DRAFTING STANDARD TE 8.5X11 - 2018.sldstd")
boolstatus = Part.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDrawingSheetsMatchCustomPropVals, 0, False)
MsgBox ("Lightweight, Suppressed, and Envelope Components Skipped: " & vbNewLine & vbNewLine & " " & SkipCount & vbNewLine & vbNewLine & "Subassemblies in Master: " & vbNewLine & vbNewLine & " " & AssCount & vbNewLine & vbNewLine & "Components included in Part Set: " & vbNewLine & vbNewLine & " " & UBound(GoodComponents) + 1 & vbNewLine & vbNewLine & "Procedure ran in:" & vbNewLine & vbNewLine & " " & Timer - startTime & " seconds")
End Sub
SolidworksApi/macros
