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()


                              Set swSubSubFeat = swSubSubFeat.GetNextSubFeature()


                          Set swSubFeat = swSubFeat.GetNextSubFeature()


                      Set swFeat = swFeat.GetNextFeature


              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