4 Replies Latest reply on Sep 18, 2017 10:07 AM by Amen Allah Jlili

    Macro To Find Specific Virtual Part By Name And Update Custom Property Field

    Orb D.

      I have a large assembly with sub-assemblies containing virtual parts. I am looking to make a macro that will grab virtual parts starting with "xxx" in the name and update a custom property within them.

        • Re: Macro To Find Specific Virtual Part By Name And Update Custom Property Field
          Peter Brinkhuis

          What do you have so far? Have you been able to copy an assembly traversal example from the help? Have you split the problem up into tiny problems already and looked into the help to find solutions to those problems?

            • Re: Macro To Find Specific Virtual Part By Name And Update Custom Property Field
              Orb D.

              Hi Peter,

               

              I am VERY new to writing my own VB. I have had some luck in the past modifying existing macros to work for me. I currently have the following but can't get the subs to work with each other. The macro should traverse through the assembly, through each level, grab the components starting with name "xxxx" then write the custom property value.

               

               

              Sub TraverseFeatureFeatures(swFeat As SldWorks.Feature, nLevel As Long)

               

               

                  Dim swSubFeat                   As SldWorks.Feature

                  Dim swSubSubFeat                As SldWorks.Feature

                  Dim swSubSubSubFeat             As SldWorks.Feature

                  Dim sPadStr                     As String

                  Dim i                           As Long

                  For i = 0 To nLevel

                      sPadStr = sPadStr + "  "

                  Next i

                  While Not swFeat Is Nothing

                      Debug.Print sPadStr + swFeat.Name + " [" + swFeat.GetTypeName + "]"

                      Set swSubFeat = swFeat.GetFirstSubFeature

                      While Not swSubFeat Is Nothing

                          Debug.Print sPadStr + "  " + swSubFeat.Name + " [" + swSubFeat.GetTypeName + "]"

                          Set swSubSubFeat = swSubFeat.GetFirstSubFeature

                          While Not swSubSubFeat Is Nothing

                              Debug.Print sPadStr + "    " + swSubSubFeat.Name + " [" + swSubSubFeat.GetTypeName + "]"

                              Set swSubSubSubFeat = swSubFeat.GetFirstSubFeature

                              While Not swSubSubSubFeat Is Nothing

                                  Debug.Print sPadStr + "      " + swSubSubSubFeat.Name + " [" + swSubSubSubFeat.GetTypeName + "]"

                                  Set swSubSubSubFeat = swSubSubSubFeat.GetNextSubFeature()

                              Wend

                              Set swSubSubFeat = swSubSubFeat.GetNextSubFeature()

                          Wend

                          Set swSubFeat = swSubFeat.GetNextSubFeature()

                      Wend

                      Set swFeat = swFeat.GetNextFeature

                  Wend

              End Sub

               

               

              Sub CustomProperty(swComp As SldWorks.Component2)

                  Dim swApp                   As SldWorks.SldWorks

                  Dim swModel                 As SldWorks.ModelDoc2

                  Dim vConfigName             As Variant

                  Dim sConfigName             As String

                  Dim swConfig                As SldWorks.Configuration

                  Dim i                       As Long

                  Dim bRet                    As Boolean

               

                  Set swModel = swApp.ActiveDoc

                

                  Set swApp = CreateObject("SldWorks.Application")

               

               

                  Set swModel = swApp.ActiveDoc

               

               

                  Set swConfig = swModel.GetActiveConfiguration

               

               

                  Dim swCustPropMgr As SldWorks.CustomPropertyManager

               

               

                   

                  vConfigName = swModel.GetConfigurationNames

               

               

                  For i = 0 To UBound(vConfigName)

               

               

                      sConfigName = vConfigName(i)

                

                    

                  Set swConfig = swModel.GetConfigurationByName(sConfigName)

                      Set swCustPropMgr = swModel.Extension.CustomPropertyManager(sConfigName)

               

               

                      swCustPropMgr.Add2 "3Dlayout_ModelUniqueId"

                      swCustPropMgr.Set "3Dlayout_ModelUniqueId", "33333"

                    

                  Next i

                                  

              End Sub

               

              Sub TraverseModelFeatures(swModel As SldWorks.ModelDoc2, nLevel As Long)

                  Dim swFeat As SldWorks.Feature

                  Set swFeat = swModel.FirstFeature

                  TraverseFeatureFeatures swFeat, nLevel

               

               

              End Sub

               

               

              Sub main()

                  Dim swApp                       As SldWorks.SldWorks

                  Dim swModel                     As SldWorks.ModelDoc2

                  Dim swConfMgr                   As SldWorks.ConfigurationManager

                  Dim swConf                      As SldWorks.Configuration

                  Dim swRootComp                  As SldWorks.Component2

                         

                  Set swApp = CreateObject("SldWorks.Application")

                  Set swModel = swApp.ActiveDoc

                  Set swConfMgr = swModel.ConfigurationManager

                  Set swConf = swConfMgr.ActiveConfiguration

                  Set swRootComp = swConf.GetRootComponent3(True)

                  Debug.Print "File = " & swModel.GetPathName

                 

              TraverseModelFeatures swModel, 1

                    

              End Sub