Renaming permanent and virtual components using SOLIDWORKS API
This VBA macro renames any selected components (root level, component in sub-assembly and virtual) using SOLIDWORKS API.
New name of the component is composed from the specified SUFFIX value
Const SUFFIX As String = "_New" 'new component name will be appended with the '_New' suffix Const PRP_NAME As String = "PartNo" 'new component name will be composed form the value of 'PartNo' custom property
If PRP_NAME constant is specified, name of the component will be composed from the value of this custom property. Macro will try to read this property from configuration specific property and if not specified, value will be read from file custom property.
If PRP_NAME constant is not specified, component base name will derive from existing component name.
Component Name
IComponent2::Name2 SOLIDWORKS API property provides get and set accessors for reading and changing the component name respectively.
This function returns different names structures when setting or getting. That means if it is required to rename component using its original name (i.e. add suffix or prefix) value returned from get-accessor needs to be altered.
When get accessor is called full name of the component is returned, while set accessor only requires short name.
Full name of the component consists of
- Component Name
- Component Index (specified after - symbol in full name)
- Context name for virtual component (specified after ^ symbol in the full name)
- Parent assembly full name (specified before / symbol in the full name)
The names of the components in the structure above will be returned as the following (the colors in the picture match the parts in names)
Assem2-1 Root component
Assem2-1/Part1-1 Component in sub-assembly
Assem2-1/Part2^Assem2-1 virtual component in sub-assembly
Const SUFFIX As String = "_Renamed" Const PRP_NAME As String = "" Dim swApp As SldWorks.SldWorks Sub main() Set swApp = Application.SldWorks If False <> swApp.GetUserPreferenceToggle(swUserPreferenceToggle_e.swExtRefUpdateCompNames) Then Err.Raise vbError, "", "Uncheck option System Options->External References->Updated component names when documents are replaced" End If Dim swModel As SldWorks.ModelDoc2 Dim swSelMgr As SldWorks.SelectionMgr Set swModel = swApp.ActiveDoc If Not swModel Is Nothing Then Dim vComps As Variant vComps = GetSelectedComponents(swModel) If Not IsEmpty(vComps) Then Dim i As Integer For i = 0 To UBound(vComps) Dim swComp As SldWorks.Component2 Set swComp = vComps(i) Dim newCompName As String newCompName = GetNewComponentName(swComp) Dim compInst As Integer compInst = GetComponentInstance(swComp) If False <> swComp.Select4(False, Nothing, False) Then swComp.Name2 = newCompName If LCase(swComp.Name2) <> LCase(newCompName & "-" & compInst) Then Err.Raise vbError, "", "Failed to rename component '" & swComp.Name2 & "' to '" & newCompName & "'" End If Else Err.Raise vbError, "", "Failed to select component '" & swComp.Name2 & "'" End If Next Else Err.Raise vbError, "", "Please select components to rename" End If Else MsgBox "Please open assembly document" End If End Sub Function GetNewComponentName(comp As SldWorks.Component2) As String Dim compName As String If PRP_NAME <> "" Then compName = GetCustomPropertyValue(comp, PRP_NAME) If compName = "" Then Err.Raise vbError, "", "Failed to get custom proeprty value from '" & comp.Name2 & "'" End If Else compName = comp.Name2 If Not comp.GetParent() Is Nothing Then 'if not root remove the sub-assemblies name compName = Right(compName, Len(compName) - InStrRev(compName, "/")) End If If comp.IsVirtual() Then 'if virtual remove the context assembly name compName = Left(compName, InStr(compName, "^") - 1) Else 'remove the index name compName = Left(compName, InStrRev(compName, "-") - 1) End If End If Dim newCompName As String newCompName = compName & SUFFIX GetNewComponentName = newCompName End Function Function GetComponentInstance(comp As SldWorks.Component2) As Integer Dim instId As Integer Dim compName As String compName = comp.Name2 instId = CInt(Right(compName, Len(compName) - InStrRev(compName, "-"))) GetComponentInstance = instId End Function Function GetCustomPropertyValue(comp As SldWorks.Component2, prpName As String) As String Dim swRefDoc As SldWorks.ModelDoc2 Set swRefDoc = comp.GetModelDoc2 If Not swRefDoc Is Nothing Then Dim prpVal As String swRefDoc.Extension.CustomPropertyManager(comp.ReferencedConfiguration).Get3 prpName, False, "", prpVal If prpVal = "" Then swRefDoc.Extension.CustomPropertyManager("").Get3 prpName, False, "", prpVal End If GetCustomPropertyValue = prpVal Else Err.Raise vbError, "", "Reference document of '" & swComp.Name2 & "' is not loaded" End If End Function Function GetSelectedComponents(model As SldWorks.ModelDoc2) As Variant Dim swSelMgr As SldWorks.SelectionMgr Set swSelMgr = model.SelectionManager Dim swComps() As SldWorks.Component2 Dim i As Integer For i = 1 To swSelMgr.GetSelectedObjectCount2(-1) Dim swComp As SldWorks.Component2 Set swComp = swSelMgr.GetSelectedObjectsComponent4(i, -1) If Not swComp Is Nothing Then If (Not swComps) = -1 Then ReDim swComps(0) Set swComps(0) = swComp 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 (Not swComps) = -1 Then GetSelectedComponents = Empty Else GetSelectedComponents = swComps End If End Function 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