Macro to rename dimensions in the SOLIDWORKS drawing view
SOLIDWORKS allows assigning the custom dimension names in the 3D documents (parts and assemblies).
However dimension name is read-only and cannot be changed for the dimensions in the drawing view.
In some cases it might be beneficial to assign the custom name to dimensions in the drawing views. For example when dimensions are part of the inspection report or a part of drawings automation software such as DriveWorks.
This VBA macro allows to assign the custom name of the dimensions in the drawing views.
Select the dimension which name should be changed and run the macro.
Specify new name in the appeared box.
{width=600}
After the name is specified dimension name is set to new value.
It is also possible to assign the full name of the dimension in the format of \<Dimension Name>@\<Feature Name> (e.g. MyDimension@MyView). In this case macro will rename the parent view as well. This is beneficial for the views which cannot be renamed (e.g. Section Views)
Dim swApp As SldWorks.SldWorks
Sub main()
Set swApp = Application.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
Err.Raise vbError, "", "Select drawing dimension"
End If
Dim swDispDim As SldWorks.DisplayDimension
Set swDispDim = swModel.SelectionManager.GetSelectedObject6(1, -1)
If swDispDim Is Nothing Then
Err.Raise vbError, "", "Please seelct dimension"
End If
Dim swDim As SldWorks.dimension
Set swDim = swDispDim.GetDimension2(0)
Dim newName As String
newName = InputBox("Specify new name for this dimension", "Dimensions Renamer", swDim.Name)
If newName <> "" Then
If InStr(newName, "@") <> 0 Then
Dim vNameParts As Variant
vNameParts = Split(newName, "@")
newName = vNameParts(0)
Dim featName As String
featName = vNameParts(1)
RenameFeature swModel, swDim, featName
End If
swDim.Name = newName
End If
End Sub
Sub RenameFeature(model As SldWorks.ModelDoc2, dimension As SldWorks.dimension, newFeatName As String)
Dim vDimNameParts As Variant
vDimNameParts = Split(dimension.FullName, "@")
Dim featName As String
featName = vDimNameParts(1)
Dim swFeat As SldWorks.Feature
Set swFeat = model.FeatureByName(featName)
If swFeat Is Nothing Then
Err.Raise vbError, "", "Faield to find the feature by name: " & featName
End If
swFeat.Name = newFeatName
End Sub