6 Replies Latest reply on Apr 15, 2019 8:20 AM by Artem Taturevych

    Macro to Rename Feature Tree Elements in a Part File?

    Victor Carosi

      Hello SW Forums,

       

      I get a lot of part files from China. As such, the entire feature tree is in Chinese, and makes working with the files a headache. I would like to rename each element in the feature tree back to English, starting from the top. See below picture for an ideal before/after:

       

       

      This seems like an ideal task for a macro. I've done some googling and found this thread: feature manager drawwing renaming macro

       

      This seems to do exactly what I want, but it only works on drawings. I would like it to work on parts, and I have very little experience in the way of SolidWorks coding. Can anyone make this work for part files? That would be tremendous.

        • Re: Macro to Rename Feature Tree Elements in a Part File?
          Danniel Sims

          Victor,

           

          I use a macro to rename all the imported pieces under the origin after the main file (eliminates proprietary info).  It's not exactly what you need since I skip over everything above the origin, but you should be able to rewrite those sections to fit your needs.  I have a lot of Japanese stored in files, so gettypename works better than trying to get ascii characters that VBA treats as wildcards.

           

          Good luck:

           

          Dim swApp As SldWorks.SldWorks

          Dim swModel As SldWorks.ModelDoc2

          Dim swModelDocExt As SldWorks.ModelDocExtension

          Dim swFeatMgr As SldWorks.FeatureManager

          Dim count As Long

          Dim featArr As Variant

          Dim swSelMgr As SldWorks.SelectionMgr

          Dim swModeler As SldWorks.Modeler

          Dim TYP

          Dim f, fs, fso

          Dim strPath As String

          Dim strFile As String

          Dim X, path, xlWB

          Public fr

          Dim ExcelRunning As Boolean

          Dim Part As Object

          Dim boolstatus As Boolean

          Dim longstatus As Long, longwarnings As Long

           

           

          Sub Rename_Feature()

           

          Set swApp = Application.SldWorks

          Set swModeler = swApp.GetModeler

          Set swModel = swApp.ActiveDoc

          Set swModelDocExt = swModel.Extension

          Set swFeatMgr = swModel.FeatureManager

          count = swFeatMgr.GetFeatureCount(False)

          featArr = swFeatMgr.GetFeatures(False)

          Set swSelMgr = swModel.SelectionManager

           

          'MsgBox featArr(i).Name

           

          Dim doc_nam, doc_split, doc_count, doc_path, d, nam, rcount

           

          doc_nam = swModel.GetPathName

          doc_split = Split(doc_nam, "\")

          doc_count = UBound(doc_split)

          nam = Split(doc_split(doc_count), ".")

          rcount = swFeatMgr.GetFeatureCount(True) + 1

           

          Dim i, t

           

          i = 1

          Set swSelMgr = swModel.SelectionManager

          Do Until i = rcount + 1

              If featArr(i).GetTypeName = "MateGroup" Then

                  Exit Do

              Else

                  If featArr(i).GetTypeName = "OriginProfileFeature" Then

                      i = i + 1 ' skip 2 folders (1 normally)

                      Do Until i = rcount

                          If Len(i - 15) = 1 Then

                              t = nam(0) & "_000" & i - 15

                          Else

                              If Len(i - 15) = 2 Then

                                  t = nam(0) & "_00" & i - 15

                              Else

                                  If Len(i - 15) = 3 Then

                                      t = nam(0) & "_0" & i - 15

                                  Else

                                      t = nam(0) & "_" & i - 15

                                  End If

                              End If

                          End If

               

                          If featArr(i).Name = t Then

                              'Do Nothing

                          Else

                              featArr(i).Name = t

                          End If

                      i = i + 1

                      Loop

                  End If

              End If

          i = i + 1

          Loop

           

          swModel.Save

           

          End Sub

            • Re: Macro to Rename Feature Tree Elements in a Part File?
              Victor Carosi

              I pulled this off that forum:

               

              Dim swApp As SldWorks.SldWorks

              Dim swPart As SldWorks.PartDoc

              Dim swFeat As SldWorks.Feature

              Dim newName As String

               

               

              Dim dicFeatsCount As Object

               

               

              Dim collFeatsNonIncr As Collection

              Dim dicBaseNames As Object

               

               

              Const FrontPlane = "Front Plane"

              Const TopPlane = "Top Plane"

              Const RightPlane = "Right Plane"

              Const Origin = "Origin"

               

               

              Dim isRefGeom As Boolean

               

               

              Sub main()

               

               

                  Set dicFeatsCount = CreateObject("Scripting.Dictionary")

                   

                  Set collFeatsNonIncr = New Collection

                   

                  Set dicBaseNames = CreateObject("Scripting.Dictionary")

                   

                  isRefGeom = False

                   

                  'Add the list of features which shouldn't be incremented

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

                  collFeatsNonIncr.Add "HistoryFolder"

                  collFeatsNonIncr.Add "SensorFolder"

                  collFeatsNonIncr.Add "DocsFolder"

                  collFeatsNonIncr.Add "DetailCabinet"

                  collFeatsNonIncr.Add "MaterialFolder"

                  collFeatsNonIncr.Add "OriginProfileFeature"

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

                   

                  'Add the list of predefined base names

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

                  dicBaseNames.Add "MaterialFolder", "Material <not specified>"

                  dicBaseNames.Add "OriginProfileFeature", "Origin"

                  dicBaseNames.Add "ProfileFeature", "Sketch"

                  'dicBaseNames.Add "Boss", "Boss-Extrude"

                  'dicBaseNames.Add "RefPlane", "Plane"

                  'dicBaseNames.Add "RevCut", "Revolved-Cut"

                  'dicBaseNames.Add "Revolution", "Revolve"

                  'dicBaseNames.Add "Cut", "Cut-Extrude"

                  'dicBaseNames.Add "DelFace", "Delete-Face"

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

               

               

                  Set swApp = Application.SldWorks

                   

                  Set swPart = swApp.ActiveDoc

                   

                  Set swFeat = swPart.FirstFeature

                   

                  While Not swFeat Is Nothing

                       

                      If dicFeatsCount.exists(swFeat.GetTypeName2()) Then

                          dicFeatsCount.Item(swFeat.GetTypeName2()) = dicFeatsCount.Item(swFeat.GetTypeName2()) + 1

                      Else

                          dicFeatsCount.Add swFeat.GetTypeName2(), 1

                      End If

                       

                      If dicBaseNames.exists(swFeat.GetTypeName2()) Then

                          newName = dicBaseNames.Item(swFeat.GetTypeName2())

                      Else

                          newName = swFeat.GetTypeName2()

                      End If

                       

                      Dim i As Integer

                       

                      Dim isIncremented As Boolean

                      isIncremented = True

                      For i = 1 To collFeatsNonIncr.Count

                          If collFeatsNonIncr(i) = swFeat.GetTypeName2() Then

                              isIncremented = False

                              Exit For

                          End If

                      Next

                       

                      If isIncremented Then

                          newName = newName & dicFeatsCount.Item(swFeat.GetTypeName2())

                      End If

                       

                      If swFeat.GetTypeName2 = "MaterialFolder" Then

                           

                          isRefGeom = True

                           

                          Dim sMatName As String

                           

                          sMatName = swPart.GetMaterialPropertyName2("", "")

                           

                          If sMatName <> "" Then

                              newName = sMatName

                          End If

                           

                      End If

                       

                      swFeat.Name = newName

                       

                      Set swFeat = swFeat.GetNextFeature

                       

                      If isRefGeom Then

                           

                          swFeat.Name = FrontPlane

                           

                          Set swFeat = swFeat.GetNextFeature

                          swFeat.Name = TopPlane

                           

                          Set swFeat = swFeat.GetNextFeature

                          swFeat.Name = RightPlane

                           

                          Set swFeat = swFeat.GetNextFeature

                          swFeat.Name = Origin

                               

                          Set swFeat = swFeat.GetNextFeature

                          isRefGeom = False

                      End If

                       

                  Wend

                   

              End Sub

               

              This works mostly. It works for almost everything but all extruded cuts and bosses beyond the first are renamed to ICE1, ICE2, ICE3, etc. I don't know enough about SolidWorks VBA to fix this. It seems like this should work. It seems like the GetTypeName function works as intended for most but not all features, and I don't know why that is.

               

              I added some lines using dicBaseNames.Add - the intention was to properly rename some features. For instance, revolved cuts were being renamed to "RevCut", but that line of code was able to give me "Revolved-Cut" as we typically see in the feature tree. I commented it out because I didn't understand why it was working for revolved cuts but not boss extrudes.

               

              Any advice on this?