Gregg Essex

Add saved BOM sort to existing Macro

Discussion created by Gregg Essex on Aug 21, 2019

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

 

Outcomes