AnsweredAssumed Answered

Traverse Assembly and Run Different Macros on Different Components

Question asked by Vince Pappert on Sep 26, 2017
Latest reply on Sep 28, 2017 by Jacob Corder

Hey All,

 

First and foremost, I'd like to thank the users of the API forum for making some pretty awesome macros available for all to use.

I started out only a couple of weeks ago and have learned so much from browsing these forums and just playing around to see what functions do what.

I've written a couple of part property macros with different fragments of code pulled from this site and some personal touches that work well for what they are.

But, I'd like to implement them on a larger scale and I think I'm close, but I'm having some trouble finishing it properly.

 

Task: Update file properties for all assemblies and parts (1,000+)

Then update drawing templates and sheet formats, rebuild, save, and save to pdf. (I have only touched on this and have failed thus far, not part of today's concern)

 

Application: Traverse the main project assembly, open assemblies and parts individually, run 1 of 5 macros depending on certain file properties or don't run anything if it is hardware, save part or assembly, close, open next, and so on.

 

Problems: I have yet to be able to skip over hardware that I do not want to run a macro on.

I am trying to compare the filename to a list, "Screw*", "Washer*", etc. but I get a mismatch error.

Also, I am only able to open parts and not assemblies.

 

Thank you all in advance for any support and advice you may provide!!

 

Current iteration:

 

' Description:

' Traverses the open assembly, activates all components, and runs the proper macro.

 

 

Private Const BIF_RETURNONLYFSDIRS As Long = &H1

Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2

Private Const BIF_RETURNFSANCESTORS As Long = &H8

Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000

Private Const BIF_BROWSEFORPRINTER As Long = &H2000

Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000

Private Const MAX_PATH As Long = 260

 

 

Sub ShowAllOpenFiles()

Dim swDoc As SldWorks.ModelDoc2

Dim swAllDocs As EnumDocuments2

Dim FirstDoc As SldWorks.ModelDoc2

Dim dummy As Boolean

Dim NumDocsReturned As Long

Dim DocCount As Long

Dim i As Long

Dim sMsg As String

Dim swApp As SldWorks.SldWorks

Dim bDocWasVisible As Boolean

Dim OpenWarnings As Long

Dim OpenErrors As Long

Dim DwgPath As String

Dim myDwgDoc As SldWorks.ModelDoc2

Dim drwPathName As String

Dim lErrors As Long

Dim lWarnings As Long

Dim boolstatus As Boolean

   

Set swApp = Application.SldWorks

Set swAllDocs = swApp.EnumDocuments2

Set FirstDoc = swApp.ActiveDoc

  

DocCount = 0

swAllDocs.Reset

swAllDocs.Next 1, swDoc, NumDocsReturned

While NumDocsReturned <> 0

    bDocWasVisible = swDoc.Visible

   

'NEED TO OPEN ASSEMBLIES AND PARTS

'=============================================================================

    DwgPath = swDoc.GetPathName

       Set myDwgDoc = swApp.OpenDoc6(DwgPath, swDocPART, swOpenDocOptions_Silent, "", OpenErrors, OpenWarnings)

        If Not myDwgDoc Is Nothing Then

            swApp.ActivateDoc myDwgDoc.GetPathName

'=============================================================================

 

Dim Part As ModelDoc2

Set Part = swApp.ActiveDoc()

 

 

Dim FileName As Variant

Dim retval As Variant

Dim PartNumber As String

Dim Manufacturer As String

Dim valout As String

Dim swCustProp As SldWorks.CustomPropertyManager

 

 

Set swCustProp = Part.Extension.CustomPropertyManager("")

 

 

        retval = swCustProp.Get4("PART NUMBER", False, PartNumber, valout)

        retval = swCustProp.Get4("MANUFACTURER", False, Manufacturer, valout)

       

        FileName = Mid(Part.GetPathName, InStrRev(Part.GetPathName, "\") + 1)

        FileName = Left(FileName, InStrRev(FileName, ".") - 1)

       

'PROBLEM AREA

'=============================================================================

        If FileName Like "*Screw*" Or "*Washer*" Or "*Nut*" Or "*Dowel*" Then

        MsgBox ("No Hardware!")

        Else

'=============================================================================

               

        If Part.GetType = swDocPART And Manufacturer = "MACHINED" Then

            swApp.RunMacro2 "Y:\MACROS\ELITE G3\Solidwork 2016 SP 1.0\MACHINED_EG3_SW16 SP1.0.swp", "MACHINED_EG31", "Main", swRunMacroDefault, Empty

            Else

           

        If Part.GetType = swDocPART And Not (PartNumber Like "B-*" Or PartNumber Like "D-*") And Manufacturer <> "MACHINED" Then

            swApp.RunMacro2 "Y:\MACROS\ELITE G3\Solidwork 2016 SP 1.0\PURCHASED_EG3_SW16 SP1.0.swp", "PURCHASED_EG31", "Main", swRunMacroDefault, Empty

            Else

           

        If Part.GetType = swDocASSEMBLY And Not (PartNumber Like "B-*" Or PartNumber Like "D-*") And Manufacturer <> "MACHINED" Then

            swApp.RunMacro2 "Y:\MACROS\ELITE G3\Solidwork 2016 SP 1.0\PURCHASED_EG3_SW16 SP1.0.swp", "PURCHASED_EG31", "Main", swRunMacroDefault, Empty

            Else

           

        If Part.GetType = swDocASSEMBLY And PartNumber Like "B-*" Or PartNumber Like "D-*" And Manufacturer <> "ASSEMBLY" Then

            swApp.RunMacro2 "Y:\MACROS\ELITE G3\Solidwork 2016 SP 1.0\MODIFIED PURCHASED_EG3_SW16 SP1.0.swp", "MODIFIED_PURCHASED_EG31", "Main", swRunMacroDefault, Empty

            Else

                   

        If Part.GetType = swDocASSEMBLY And PartNumber Like "B-*" Or PartNumber Like "D-*" And Manufacturer = "ASSEMBLY" Then

            swApp.RunMacro2 "Y:\MACROS\ELITE G3\Solidwork 2016 SP 1.0\ASSEMBLY_EG3_SW16 SP1.0.swp", "ASSEMBLY_EG31", "Main", swRunMacroDefault, Empty

           

        End If

        End If

        End If

        End If

        End If

        End If

 

    swApp.QuitDoc (Part.GetTitle)

            Set myDwgDoc = Nothing

        End If

    swAllDocs.Next 1, swDoc, NumDocsReturned

    DocCount = DocCount + 1

Wend

 

swApp.ActivateDoc FirstDoc.GetPathName

 

End Sub

Outcomes