VBA macro to rename features based on type names using SOLIDWORKS API

Edit ArticleEdit Article
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


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


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

This is a 2 column CSV file


Feature Types

Feature types are language independent identifiers 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)
        vTable = ReadCsvFile(swApp.GetCurrentMacroPathFolder() & "\" & CUSTOM_MAP_FILE, False)
        For i = 0 To UBound(vTable)
            dicBaseNames.Add vTable(i)(0), vTable(i)(1)
        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
                dicFeatsCount.Add typeName, 1
            End If
            If dicBaseNames.exists(typeName) Then
                newName = dicBaseNames.Item(typeName)
                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
            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
        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)
                lastRowIndex = UBound(vTable, 1) + 1
                ReDim Preserve vTable(lastRowIndex)
            End If
            vTable(lastRowIndex) = vCells
        End If
        If isFirstRow Then
            isFirstRow = False
        End If
    Close #fileNo
    ReadCsvFile = vTable
    Exit Function

    ReadCsvFile = Empty
End Function

Product of Xarial Product of Xarial