More 'Goodies'

This VBA macro allows to rename the feature manager tree in the part document using SOLIDWORKS API based on specified rules and feature type names.

This macro can be used as a translator macro to rename feature tree form one language to another.

For example this feature tree is in Russian language:

Feature tree in Russian language
Feature tree in Russian language

It can be renamed to English language equivalent:

Feature tree in English version
Feature tree in English version

Configuration

Macro is using the data specified in 2 files which must be stored in the same folder as the macro:

Const NO_INCREMENT_FILE As String = "noincrement.csv"
Const CUSTOM_MAP_FILE As String = "custommap.csv"

These files can be edited in Excel or any text editor (like Notepad).

No Increment CSV File

This file contains the feature type names whose names should not be increment (i.e. they present once in a tree), for example Origin feature or Documents Folder.

This is a single column CSV file. Download

Custom Map CSV File

This file contains the special names for the feature types. By default the feature will be named after its type, but this behavior can be overridden in this file. For example type name for the Sketch feature is OriginProfileFeature, so by default all sketches will be renamed to OriginProfileFeature1, OriginProfileFeature2, OriginProfileFeature3 etc., unless the following line is added to custommap.csv file

OriginProfileFeature,Sketch

In this case the sketches will be renamed to Sketch1, Sketch2, Sketch3

This is a 2 column CSV file

Download

Feature Types

Feature types are language independent identifers of feature kind. Use Get Features Type Name VBA macro to extract type names. Use Type Name 2 unless it is equal to ICE (in this case use Type Name 1)

Special Feature Types

There are several special types of feature which can be used for renaming

  • _FrontPlane
  • _RightPlane
  • _TopPlane
Const NO_INCREMENT_FILE As String = "noincrement.csv"
Const CUSTOM_MAP_FILE As String = "custommap.csv"

Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks
    
    Dim swPart As SldWorks.PartDoc
    
    Set swPart = TryGetActivePart()
    
    If Not swPart Is Nothing Then
    
        Dim dicFeatsCount As Object
        Dim collFeatsNonIncr As Collection
        Dim dicBaseNames As Object
        
        Set dicFeatsCount = CreateObject("Scripting.Dictionary")
        Set collFeatsNonIncr = New Collection
        Set dicBaseNames = CreateObject("Scripting.Dictionary")
        
        Dim vTable As Variant
        Dim i As Integer
        
        vTable = ReadCsvFile(swApp.GetCurrentMacroPathFolder() & "\" & NO_INCREMENT_FILE, False)
        
        For i = 0 To UBound(vTable)
            collFeatsNonIncr.Add vTable(i)(0)
        Next
        
        vTable = ReadCsvFile(swApp.GetCurrentMacroPathFolder() & "\" & CUSTOM_MAP_FILE, False)
        
        For i = 0 To UBound(vTable)
            dicBaseNames.Add vTable(i)(0), vTable(i)(1)
        Next
        
        Dim swFeat As SldWorks.Feature
        Set swFeat = swPart.FirstFeature
        
        Dim curRefPlanePos As Integer
        curRefPlanePos = 0
        
        While Not swFeat Is Nothing
            
            Dim newName As String
            
            Dim typeName As String
            typeName = GetTypeName(swFeat, curRefPlanePos)
            
            If dicFeatsCount.exists(typeName) Then
                dicFeatsCount.Item(typeName) = dicFeatsCount.Item(typeName) + 1
            Else
                dicFeatsCount.Add typeName, 1
            End If
            
            If dicBaseNames.exists(typeName) Then
                newName = dicBaseNames.Item(typeName)
            Else
                newName = typeName
            End If
            
            Dim isIncremented As Boolean
            isIncremented = True
            For i = 1 To collFeatsNonIncr.Count
                If collFeatsNonIncr(i) = typeName Then
                    isIncremented = False
                    Exit For
                End If
            Next
            
            If isIncremented Then
                newName = newName & dicFeatsCount.Item(typeName)
            End If
            
            If typeName = "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
            
        Wend
        
    Else
        MsgBox "Please open the part document"
    End If
    
End Sub

Function GetTypeName(feat As SldWorks.Feature, ByRef curRefPlanePos As Integer) As String

    Dim typeName As String
    
    typeName = feat.GetTypeName2()
    
    If typeName = "RefPlane" Then
    
        Select Case curRefPlanePos
            Case 0
                typeName = "_FrontPlane"
            Case 1
                typeName = "_TopPlane"
            Case 2
                typeName = "_RightPlane"
        End Select
        
        curRefPlanePos = curRefPlanePos + 1
        
    ElseIf typeName = "ICE" Then
    
        typeName = feat.GetTypeName()
        
    End If
    
    GetTypeName = typeName
    
End Function

Function TryGetActivePart() As SldWorks.PartDoc
    
    Dim swModel As SldWorks.ModelDoc2
    
    Set swModel = swApp.ActiveDoc
    
    If Not swModel Is Nothing Then
        If swModel.GetType() = swDocumentTypes_e.swDocPART Then
            Set TryGetActivePart = swModel
        End If
    End If
    
End Function

Function ReadCsvFile(filePath As String, firstRowHeader As Boolean) As Variant
    
    'rows x columns
    Dim vTable() As Variant
    
    On Error GoTo Error
    
    Dim fileName As String
    Dim tableRow As String
    Dim fileNo As Integer

    fileNo = FreeFile
    
    Open filePath For Input As #fileNo
    
    Dim isFirstRow As Boolean
    Dim isTableInit As Boolean
    
    isFirstRow = True
    isTableInit = False
    
    Do While Not EOF(fileNo)
        
        Line Input #fileNo, tableRow
            
        If Not isFirstRow Or Not firstRowHeader Then
            
            Dim vCells As Variant
            vCells = Split(tableRow, ",")
            
            Dim lastRowIndex As Integer
            
            If Not isTableInit Then
                lastRowIndex = 0
                isTableInit = True
                ReDim Preserve vTable(lastRowIndex)
            Else
                lastRowIndex = UBound(vTable, 1) + 1
                ReDim Preserve vTable(lastRowIndex)
            End If
            
            vTable(lastRowIndex) = vCells
            
        End If
        
        If isFirstRow Then
            isFirstRow = False
        End If
    
    Loop
    
    Close #fileNo
    
    ReadCsvFile = vTable
    
    Exit Function
    
Error:

    ReadCsvFile = Empty
    
End Function