SOLIDWORKS macro renames all features in model sequentially
More 'Goodies'
This macro renames all the features in active model in the sequential order using SOLIDWORKS API, preserving the base names .
Only indices are renamed and the base name is preserved. For example Sketch21 will be renamed to Sketch1 for the first appearance of the sketch feature.
Notes
- Only features with number at the end will be renamed (e.g. Front Plane will not be renamed to Front Plane1 and My1Feature will not be renamed)
- Case is ignored (case insensitive search)
- Only modelling features are renamed (the ones created after the Origin feature)
- In the assembly documents, only assembly feature are renamed (components are ignored)
- If components are selected in the assembly, features of those components will be renamed
Watch video demonstration
Dim swApp As SldWorks.SldWorks Dim swModel As SldWorks.ModelDoc2 Sub main() Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc try_: On Error GoTo catch_ If Not swModel Is Nothing Then swModel.FeatureManager.EnableFeatureTree = False swModel.FeatureManager.EnableFeatureTreeWindow = False Dim vComps As Variant vComps = GetSelectedComponents(swModel.SelectionManager) If Not IsEmpty(vComps) Then Dim i As Integer For i = 0 To UBound(vComps) Dim swComp As SldWorks.Component2 Set swComp = vComps(i) ProcessFeatureTree swComp.FirstFeature, swComp Next Else ProcessFeatureTree swModel.FirstFeature, swModel End If Else Err.Raise vbError, "", "Please open model" End If GoTo finally_ catch_: swApp.SendMsgToUser2 Err.Description, swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk finally_: If Not swModel Is Nothing Then swModel.FeatureManager.EnableFeatureTree = True swModel.FeatureManager.EnableFeatureTreeWindow = True End If End Sub Sub ProcessFeatureTree(firstFeat As SldWorks.Feature, owner As Object) Dim passedOrigin As Boolean passedOrigin = False Dim featNamesTable As Object Dim processedFeats() As SldWorks.Feature Set featNamesTable = CreateObject("Scripting.Dictionary") featNamesTable.CompareMode = vbTextCompare 'case insensitive Dim swFeat As SldWorks.Feature Set swFeat = firstFeat While Not swFeat Is Nothing If passedOrigin Then If Not Contains(processedFeats, swFeat) Then If (Not processedFeats) = -1 Then ReDim processedFeats(0) Else ReDim Preserve processedFeats(UBound(processedFeats) + 1) End If Set processedFeats(UBound(processedFeats)) = swFeat RenameFeature swFeat, featNamesTable, owner End If Dim swSubFeat As SldWorks.Feature Set swSubFeat = swFeat.GetFirstSubFeature While Not swSubFeat Is Nothing If Not Contains(processedFeats, swSubFeat) Then If (Not processedFeats) = -1 Then ReDim processedFeats(0) Else ReDim Preserve processedFeats(UBound(processedFeats) + 1) End If Set processedFeats(UBound(processedFeats)) = swSubFeat RenameFeature swSubFeat, featNamesTable, owner End If Set swSubFeat = swSubFeat.GetNextSubFeature Wend End If If swFeat.GetTypeName2() = "OriginProfileFeature" Then passedOrigin = True End If Set swFeat = swFeat.GetNextFeature Wend End Sub Sub RenameFeature(feat As SldWorks.Feature, featNamesTable As Object, owner As Object) If feat.GetTypeName2() <> "Reference" Then Dim baseFeatName As String If TryGetBaseName(feat.name, baseFeatName) Then Dim nextIndex As Integer If featNamesTable.Exists(baseFeatName) Then nextIndex = featNamesTable.item(baseFeatName) + 1 featNamesTable.item(baseFeatName) = nextIndex Else nextIndex = 1 featNamesTable.Add baseFeatName, nextIndex End If Dim newName As String newName = baseFeatName & nextIndex If LCase(feat.name) <> LCase(newName) Then ResolveFeatureNameConflict owner, newName feat.name = newName End If End If End If End Sub Function TryGetBaseName(name As String, ByRef baseName As String) TryGetBaseName = False baseName = "" Dim regEx As Object Set regEx = CreateObject("VBScript.RegExp") regEx.Global = True regEx.IgnoreCase = True regEx.Pattern = "(.+?)(\d+)$" Dim regExMatches As Object Set regExMatches = regEx.Execute(name) If regExMatches.Count = 1 Then If regExMatches(0).SubMatches.Count = 2 Then baseName = regExMatches(0).SubMatches(0) TryGetBaseName = True End If End If End Function Sub ResolveFeatureNameConflict(owner As Object, name As String) Const INDEX_OFFSET As Integer = 100 Dim index As Integer Dim swFeatMgr As SldWorks.FeatureManager Dim swFeat As SldWorks.Feature If TypeOf owner Is SldWorks.Component2 Then Dim swComp As SldWorks.Component2 Set swComp = owner Dim swRefModel As SldWorks.ModelDoc2 Set swRefModel = swComp.GetModelDoc2 If Not swRefModel Is Nothing Then Set swFeatMgr = swRefModel.FeatureManager Set swFeat = swComp.FeatureByName(name) Else Err.Raise vbError, "", "Component model is not loaded" End If ElseIf TypeOf owner Is SldWorks.ModelDoc2 Then Dim swModel As SldWorks.ModelDoc2 Set swModel = owner Set swFeatMgr = swModel.FeatureManager Set swFeat = swModel.FeatureByName(name) Else Err.Raise vbError, "", "Not supported owner" End If If Not swFeat Is Nothing Then Dim baseName As String If TryGetBaseName(name, baseName) Then Dim newName As String newName = baseName & (INDEX_OFFSET + index) While False <> swFeatMgr.IsNameUsed(swNameType_e.swFeatureName, newName) index = index + 1 newName = baseName & (INDEX_OFFSET + index) Wend swFeat.name = newName Else Exit Sub End If End If End Sub Function Contains(vArr As Variant, item As Object) As Boolean Dim i As Integer For i = 0 To UBound(vArr) If vArr(i) Is item Then Contains = True Exit Function End If Next Contains = False End Function Function GetSelectedComponents(selMgr As SldWorks.SelectionMgr) As Variant Dim isInit As Boolean isInit = False Dim swComps() As SldWorks.Component2 Dim i As Integer For i = 1 To selMgr.GetSelectedObjectCount2(-1) Dim swComp As SldWorks.Component2 Set swComp = selMgr.GetSelectedObjectsComponent4(i, -1) If Not swComp Is Nothing Then If Not isInit Then ReDim swComps(0) Set swComps(0) = swComp isInit = True Else If Not Contains(swComps, swComp) Then ReDim Preserve swComps(UBound(swComps) + 1) Set swComps(UBound(swComps)) = swComp End If End If End If Next If isInit Then GetSelectedComponents = swComps Else GetSelectedComponents = Empty End If End Function