20 Replies Latest reply on Sep 28, 2017 6:12 PM by Jacob Corder

    Traverse Assembly and Run Different Macros on Different Components

    Vince Pappert

      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

        • Re: Traverse Assembly and Run Different Macros on Different Components
          Vince Pappert

          Here is one of the assembly/part property macros if anyone is interested.

           

          Dim swApp As SldWorks.SldWorks

          Dim swModel As SldWorks.ModelDoc2

          Dim swCustProp As SldWorks.CustomPropertyManager

          Dim vConfs As Variant

          Dim i As Integer

          Dim retval As Variant

          Dim FileName As String

          Dim PartNumber As String

          Dim Description As String

          Dim Project As String

          Dim Material As String

          Dim Finish As String

          Dim Treatment As String

          Dim DesignBy As String

          Dim DesignDate As String

          Dim REF_ASSY_1 As String

          Dim REF_ASSY_2 As String

          Dim ReferenceAssemblies As String

          Dim Manufacturer As String

          Dim ChangeOver As String

          Dim Installation As String

          Dim Spare As String

          Dim valout As String

           

           

           

           

           

          Sub main()

           

              Set swApp = Application.SldWorks

            

              Set swModel = swApp.ActiveDoc

            

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

           

           

          'Read current custom properties and extract information if there, else prompt for new information

           

           

          retval = swCustProp.Get4("DESCRIPTION", False, Description, valout)

           

           

          retval = swCustProp.Get4("FINISH", False, Finish, valout)

           

           

          retval = swCustProp.Get4("TREATMENT", False, Treatment, valout)

           

           

          retval = swCustProp.Get4("DESIGN BY", False, DesignBy, valout)

           

           

          retval = swCustProp.Get4("DESIGN DATE", False, DesignDate, valout)

            

          retval = swCustProp.Get4("REF ASSY 1", False, REF_ASSY_1, valout)

           

           

          retval = swCustProp.Get4("REF ASSY 2", False, REF_ASSY_2, valout)

           

           

          retval = swCustProp.Get4("REFERENCE ASSEMBLIES", False, ReferenceAssemblies, valout)

           

           

          retval = swCustProp.Get4("CHANGE-OVER PART", False, ChangeOver, valout)

            

          retval = swCustProp.Get4("INSTALLATION PART (IF RECOMMENDED)", False, Installation, valout)

            

          retval = swCustProp.Get4("Spare PART (IF RECOMMENDED)", False, Spare, valout)

                

          'Delete Current Custom Properties, Call Subroutine

           

           

              ClearCustPrps ("")

            

              vConfs = swModel.GetConfigurationNames

            

              For i = 0 To UBound(vConfs)

                

                  ClearCustPrps (vConfs(i))

            

              Next

            

          'Define and Insert New Custom Properties

           

           

              'Import File Name

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

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

           

           

              'Add PART NUMBER Property

                 PartNumber = FileName

                 PartNumber = UCase(InputBox("Enter PART NUMBER", "Part Number?", PartNumber))

                 swModel.AddCustomInfo2 "PART NUMBER", 30, PartNumber

           

           

              'Add DESCRIPTION Property

                 If Len(Description) <> 2 Then

                 Description = UCase(InputBox("Enter DESCRIPTION", "Description?", Description))

                 End If

                 swModel.AddCustomInfo2 "DESCRIPTION", 30, Description

               

              'Add PROJECT Property

                 Project = "PROJECT NAME"

                 Project = UCase(InputBox("Enter PROJECT", "Project?", Project))

                 swModel.AddCustomInfo2 "PROJECT", 30, Project

               

              'Add MATERIAL Property

                 Material = "N/A"

                 Material = UCase(InputBox("Enter MATERIAL", "Material?", Material))

                 swModel.AddCustomInfo2 "MATERIAL", 30, Material

               

              'Add TREATMENT Property

                 Treatment = "NONE"

                 Treatment = UCase(InputBox("Enter TREATMENT", "Treatment?", Treatment))

                 swModel.AddCustomInfo2 "TREATMENT", 30, Treatment

               

              'Add DESIGN BY Property

                 DesignBy - "DESIGNBY"

                 DesignBy = InputBox("Enter DESIGN BY : DESIGNBY", "Design By?", DesignBy)

                 swModel.AddCustomInfo2 "DESIGN BY", 30, DesignBy

               

              'Add DESIGN DATE Property

                 If Len(DesignDate) <> 2 Then

                 DesignDate = InputBox("Enter DESIGN DATE : MM/DD/YYYY", "Design Date?", Format(DesignDate, "mm/dd/yyyy"))

                 End If

                 swModel.AddCustomInfo2 "DESIGN DATE", 30, DesignDate

               

              'Add REFERENCE ASSEMBLIES Property

                 If Len(REF_ASSY_1) = 0 Then

                 ReferenceAssemblies = InputBox("Enter REFERENCE ASSEMBLIES", "Reference Assemblies?", ReferenceAssemblies)

                 Else

                 If Len(REF_ASSY_1) <> 2 And Len(REF_ASSY_2) < 2 Then

                 ReferenceAssemblies = InputBox("Enter REFERENCE ASSEMBLIES", "Reference Assemblies?", REF_ASSY_1)

                 Else

                 If Len(REF_ASSY_1) <> 2 And Len(REF_ASSY_2) <> 2 Then

                 ReferenceAssemblies = InputBox("Enter REFERENCE ASSEMBLIES", "Reference Assemblies?", REF_ASSY_1 & ", " & REF_ASSY_2)

                 End If

                 End If

                 End If

                 swModel.AddCustomInfo2 "REFERENCE ASSEMBLIES", 30, ReferenceAssemblies

           

              'Add MANUFACTURER Property

                 Manufacturer = ""

                 Manufacturer = UCase(InputBox("Enter MANUFACTURER", "Manufacturer?", Manufacturer))

                 swModel.AddCustomInfo2 "MANUFACTURER", 30, Manufacturer

           

           

              'Add CHANGE-OVER PART Property

                 If Len(ChangeOver) <> 2 Then

                 ChangeOver = UCase(InputBox("Is this a CHANGE-OUT Part?" & vbCrLf & "" & vbCrLf & "Enter X if Yes" & vbCrLf & "Leave BLANK if No", "Change-Over Part?", ChangeOver))

                 End If

                 swModel.AddCustomInfo2 "CHANGE-OVER PART", 30, ChangeOver

           

           

              'Add INSTALLATION PART Property

                 If Len(Installation) <> 2 Then

                 Installation = UCase(InputBox("Is this an INSTALLATION Part?" & vbCrLf & "" & vbCrLf & "Enter X if Yes" & vbCrLf & "Leave BLANK if No", "Installation Part?", Installation))

                 End If

                 swModel.AddCustomInfo2 "INSTALLATION PART (IF RECOMMENDED)", 30, Installation

           

           

              'Add SPARE PART Property

                 If Len(Spare) <> 2 Then

                 Spare = UCase(InputBox("Is this a SPARE Part?" & vbCrLf & "" & vbCrLf & "Enter X if Yes" & vbCrLf & "Leave BLANK if No", "Spare Part?", Spare))

                 End If

                 swModel.AddCustomInfo2 "SPARE PART (IF RECOMMENDED)", 30, Spare

               

              'Add MANUFACTURER PART NUMBER Property

                 swModel.AddCustomInfo2 "MANUFACTURER PART NUMBER (FOR MODIFIED PARTS ONLY)", swCustomInfoText, " "

               

                 MsgBox "Document Properties Updated"

               

            

          End Sub

           

          'Subroutine Called To Delete Custom Properties

           

           

          Sub ClearCustPrps(conf As String)

           

              Dim j As Integer

            

              Set swCustProp = swModel.Extension.CustomPropertyManager(conf)

                

              If Not swCustProp Is Nothing Then

                    

                  swCustProp.GetAll vPropNames, Empty, Empty

                    

                  If Not IsEmpty(vPropNames) Then

                      For j = 0 To UBound(vPropNames)

                          swCustProp.Delete vPropNames(j)

                      Next

                  End If

                    

              End If

                

          End Sub

          • Re: Traverse Assembly and Run Different Macros on Different Components
            Amen Allah Jlili

            I really hate using these left and right. They do my head in.

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

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

            If you are trying to get the filename of the active document, why don't you use IModelDoc2::GetTitle() and be done with it

            IModelDoc2::GetTitle() gets you the title of the document that appears in the active window's title bar.


            You need to be aware of the following (from the Docs):

            The document name that appears in the window header changes based on your Windows Explorer settings. If you chose to suppress known file extensions, then the title shown in the window, and returned by this method, varies (for example, Part1.sldprt vs. Part1)


            Suppress the extension (if that possible in your system).

             

            Best,

            Amen
            CADHERO consulting SUARL – SOLIDWORKS API Automation & Training- VBA MACROS, Addins and Standalones

              • Re: Traverse Assembly and Run Different Macros on Different Components
                Vince Pappert

                Amen,

                Thank you for the advice!

                I have actually suppressed the file extensions in my explorer settings, however Solidworks (or my system) still shows .sldprt for some parts.

                The left and right code although somewhat confusing seems to work well enough.

                  • Re: Traverse Assembly and Run Different Macros on Different Components
                    Simon Turner

                    Rather than rely on GetTitle, add a reference in your macro to Microsoft Scripting Runtime (via Tools / References in the VBA Editor).

                    Then add these couple of lines:

                     

                        Dim fso As New Scripting.FileSystemObject

                        Debug.Print Replace(fso.GetFileName(FileName), "." & fso.GetExtensionName(FileName), "")

                       

                    To also open assemblies, you need to do something like this:

                    Dim myType as Long

                    If fso.GetExtensionName(FileName) = "SLDPRT" Then myType = swDocPART

                    If fso.GetExtensionName(FileName) = "SLDPASM" Then myType = swDocASSEMBLY

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

                      • Re: Traverse Assembly and Run Different Macros on Different Components
                        Vince Pappert

                        Simon,

                        I've just done as you've advised, but the Microsoft Scripting Runtime stuff is definitely out of my league.

                        I put the code in, but honestly have no idea what is truly going on.

                         

                        As for the assemblies, I used your code in some IF statements and am now able to open them!

                        However, I also receive a Microsoft Visual Basic Run-time error and the whole assembly closes.

                        Capture.JPG

                         

                        Debug.Print Replace(fso.GetFileName(FileName), "." & fso.GetExtensionName(FileName), "")

                        If fso.GetExtensionName(FileName) = "SLDPRT" Then myType = swDocPART

                        If fso.GetExtensionName(FileName) = "SLDASM" Then myType = swDocASSEMBLY

                            DwgPath = swDoc.GetPathName

                            If myType = swDocPART Then

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

                               Else

                            If myType = swDocASSEMBLEY Then

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

                                Else

                            If Not myDwgDoc Is Nothing Then

                                    swApp.ActivateDoc myDwgDoc.GetPathName

                            End If

                            End If

                         

                        It's almost there!!

                        I am still very much in the process of learning, so I do not have a lot of the fundamentals behind some of the code.

                        Thus, I'm sure there are a lot of useless lines in there doing nothing.

                  • Re: Traverse Assembly and Run Different Macros on Different Components
                    Mr Omkar Deshpande

                    Change Dim FileName As Variant to Dim FileName As String

                    Also try,

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

                      • Re: Traverse Assembly and Run Different Macros on Different Components
                        Vince Pappert

                        Mr. Deshpande,

                        I previously had FileName as String and while trying different things out, forgot to set it back.

                        Thank you for bringing that to my attention.

                        Also, your second answer is correct as well!!

                        Adding the FileName Like to each iteration I want to check, worked like a charm!

                         

                        I'm still having the issue of the code only opening parts, instead of parts and assemblies, so I am weary to hit correct answer just yet.

                        But, you have set me down the correct path, so thank you!

                          • Re: Traverse Assembly and Run Different Macros on Different Components
                            Mr Omkar Deshpande

                            I think,

                             

                            '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

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

                             

                            This is the problem..

                             

                            Try this

                             

                            'NEED TO OPEN ASSEMBLIES AND PARTS

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

                                DwgPath = swDoc.GetPathName

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

                                   If myDwgDoc Is Nothing Then Set myDwgDoc = swApp.OpenDoc6(DwgPath, swDocASSEMBLY, swOpenDocOptions_Silent, "", OpenErrors, OpenWarnings)

                                    If Not myDwgDoc Is Nothing Then

                                        swApp.ActivateDoc myDwgDoc.GetPathName

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

                             

                            I am not sure of this though...

                             

                            Though, I don't think this is the right way. You should first get the type of the document, and use it in the argument.

                            OR

                            I use swApp.OpenDoc7 (which needs the Document Specification) sometimes

                            (2012 SOLIDWORKS API Help - OpenDoc7 Method (ISldWorks) )

                              • Re: Traverse Assembly and Run Different Macros on Different Components
                                Vince Pappert

                                Mr. Deshpande,

                                 

                                The newest iteration of the code, thanks to the members of this board, does indeed retrieve the type of document first.

                                The issue now is actually running the code on the assemblies themselves.

                                When I run the swDocPART portion, everything is good.

                                When I run the swDocASSEMBLY portion, the assembly opens, the correct macro runs, but when it closes, I get an error on the following line:

                                DocCount = 0

                                swAllDocs.Reset

                                swAllDocs.Next 1, swDoc, NumDocsReturned

                                While NumDocsReturned <> 0

                                                bDocWasVisible = swDoc.Visible

                                 

                                I feel like it's right there, but I'm just missing something.

                                  • Re: Traverse Assembly and Run Different Macros on Different Components
                                    Jacob Corder

                                    See above.

                                     

                                    you cannot use IEnumDocuments2 in VBA.

                                     

                                    it is C++ in process DLLs only

                                     

                                    i assume your writing in VBA?

                                      • Re: Traverse Assembly and Run Different Macros on Different Components
                                        Vince Pappert

                                        Jacob,

                                         

                                        Thank you for the insight!

                                        You are correct, this is being written in VBA.

                                        I will try your recommendation above.

                                         

                                        In the meantime however since I am now under a time crunch, I was able to utilize another macro written by Deepak that works great!

                                        I modified the sub routine with my own and now both parts and assemblies open, update, save, and close!

                                        You will see some parts commented out as I could not get them to run properly, but this isn't a problem.

                                        Now my only issue is changing it to read only the active document instead of the file directory.

                                         

                                        Please see below:

                                        'Batch Update Properties.swp ------------- 10/02/14

                                        'Description: Macro to update specified File properties drawings.

                                        'Pre-Condition: Specify the file path in the macro. The files must contain the specified properties.

                                        'Post-Condition: Macro will update the specifeid properties and save the files.

                                        ' Folder Browse Codes: http://www.cpearson.com/excel/browsefolder.aspx

                                        ' Please back up your data before use and USE AT OWN RISK

                                        '

                                        '------------------------------------------------------------------------------------

                                        'Created by Deepak Gupta (Boxer's SOLIDWORKS Blog, India) http://gupta9665.com/

                                        '------------------------------------------------------------------------------------

                                        ' Disclaimer:

                                        ' This macro is provided as is.  No claims, support, refund, safety net, or

                                        ' warranties are expressed or implied.  By using this macro and/or its code in

                                        ' any way whatsoever, the user and any entities which the user represents,

                                        ' agree to hold the authors free of any and all liability.

                                        ' Free distribution and use of this code in other free works is welcome.

                                        ' You may redistribute it and/or modify it on the condition that this header is retained.

                                        ' All other forms of distribution (i.e., not free, fee for delivery, etc) are prohibited

                                        ' without the expressed written consent by the authors.

                                        ' Use at your own risk!

                                        ' ------------------------------------------------------------------------------

                                         

                                        Option Explicit

                                        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

                                        'Function BrowseFolder(Optional Caption As String, _

                                        '    Optional InitialFolder As String) As String

                                         

                                         

                                        'Dim SH As Shell32.Shell

                                        'Dim F As Shell32.Folder

                                         

                                         

                                        'Set SH = New Shell32.Shell

                                        'Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)

                                        'If Not F Is Nothing Then

                                        '    BrowseFolder = F.Items.Item.path

                                        'End If

                                        'End Function

                                        Sub main()

                                         

                                         

                                        Dim swApp           As SldWorks.SldWorks

                                        Dim swModel         As SldWorks.ModelDoc2

                                        Dim longstatus      As Long, longwarnings As Long

                                        Dim sFileName       As String

                                        Dim path            As String

                                        Dim sModelName      As String

                                        Dim Value           As String

                                        Dim nErrors         As Long

                                        Dim nWarnings       As Long

                                        '***************************************

                                        'On Error Resume Next

                                        Set swApp = Application.SldWorks

                                        Set swModel = swApp.ActiveDoc

                                                 

                                            'path = BrowseFolder()

                                            'If path = "" Then

                                            'MsgBox "Please select the path and try again"

                                            'End

                                            'Else

                                            'path = path & "\"

                                            'End If   

                                             

                                            sFileName = Dir(path & "*.sldprt")

                                            Do Until sFileName = ""

                                            Set swModel = swApp.OpenDoc6(path & sFileName, swDocPART, swOpenDocOptions_Silent, "", longstatus, longwarnings)

                                            Set swModel = swApp.ActiveDoc

                                            updateProperty swModel

                                            swModel.Save3 swSaveAsOptions_Silent, longstatus, longwarnings

                                            swApp.CloseDoc swModel.GetTitle

                                            Set swModel = Nothing

                                            sFileName = Dir

                                            Loop

                                           

                                            sFileName = Dir(path & "*.sldasm")

                                            Do Until sFileName = ""

                                            Set swModel = swApp.OpenDoc6(path & sFileName, swDocASSEMBLY, swOpenDocOptions_Silent, "", longstatus, longwarnings)

                                            Set swModel = swApp.ActiveDoc

                                            updateProperty swModel

                                            swModel.Save3 swSaveAsOptions_Silent, longstatus, longwarnings

                                            swApp.CloseDoc swModel.GetTitle

                                            Set swModel = Nothing

                                            sFileName = Dir

                                            Loop

                                           

                                        End Sub

                                         

                                        ' Modified by Vince

                                         

                                        Function updateProperty(swModel As SldWorks.ModelDoc2) As Boolean

                                         

                                        Dim swApp As SldWorks.SldWorks

                                        Dim FileName As String

                                        Dim retval As Variant

                                        Dim PartNumber As String

                                        Dim Manufacturer As String

                                        Dim valout As String

                                        Dim swCustProp As SldWorks.CustomPropertyManager

                                         

                                         

                                        Set swApp = Application.SldWorks

                                        Set swModel = swApp.ActiveDoc

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

                                         

                                         

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

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

                                               

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

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

                                               

                                                If FileName Like "*Screw*" Or FileName Like "*Washer*" Or FileName Like "*Nut*" Or FileName Like "*DOWEL*" Or FileName Like "*S2055*" Or FileName Like "*Vial*" Then

                                                'MsgBox ("No Updates for Hardware!")

                                                Else

                                                       

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

                                                    swApp.RunMacro2 "U:\MACROS\File Property Update\NEW\Solidwork 2016 SP 1.0\MACHINED_EG3_SW16 SP1.0.swp", "MACHINED_EG3_SW16_SP1_01", "Main", swRunMacroDefault, Empty

                                                    Else

                                                   

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

                                                    swApp.RunMacro2 "U:\MACROS\File Property Update\NEW\Solidwork 2016 SP 1.0\PURCHASED_EG3_SW16 SP1.0.swp", "PURCHASED_EG3_SW16_SP1_01", "Main", swRunMacroDefault, Empty

                                                    Else

                                                   

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

                                                    swApp.RunMacro2 "U:\MACROS\File Property Update\NEW\Solidwork 2016 SP 1.0\PURCHASED_EG3_SW16 SP1.0.swp", "PURCHASED_EG3_SW16_SP1_01", "Main", swRunMacroDefault, Empty

                                                    Else

                                                   

                                                If swModel.GetType = swDocASSEMBLY And PartNumber Like "A-*" Or PartNumber Like "B-*" Or PartNumber Like "C-*" Or PartNumber Like "D-*" And Manufacturer <> "ASSEMBLY" And Len(Manufacturer) > 1 Then

                                                    swApp.RunMacro2 "U:\MACROS\File Property Update\NEW\Solidwork 2016 SP 1.0\MODIFIED PURCHASED_EG3_SW16 SP1.0.swp", "MODIFIED_PURCHASED_EG3_SW16_SP1_01", "Main", swRunMacroDefault, Empty

                                                    Else

                                                           

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

                                                    swApp.RunMacro2 "U:\MACROS\File Property Update\NEW\Solidwork 2016 SP 1.0\ASSEMBLY_EG3_SW16 SP1.0.swp", "ASSEMBLY_EG3_SW16_SP1_01", "Main", swRunMacroDefault, Empty

                                                   

                                                End If

                                                End If

                                                End If

                                                End If

                                                End If

                                                End If

                                         

                                         

                                        End Function

                                        • Re: Traverse Assembly and Run Different Macros on Different Components
                                          Amen Allah Jlili

                                          In-process dll only doesn't mean it's for c++ only. You can use VB.NET or C#.