Perslaps
Student
- Mar 21, 2023
- 1
Hi,
I am an Irish Product Design Student currently looking to speed up my current Solidworks formatting. I have been looking at macros online and have adapted a macro I found but have hit a road block. I want to write it so the macro skips over reference dimensions (Below). I have considered using different layers but have not been able to arrive to a solution as I'm very new to VBA.
Any help is much appreciated.
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swDwg As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swDispDim As SldWorks.DisplayDimension
Dim swDim As SldWorks.Dimension
Dim sCurPrefix As String
Dim nOpenParPos As Long
Dim nCloseParPos As Long
Dim vDimVal As Variant
Dim dInchVal As Double
Dim sInchString As String
Dim sNewPrefix As String
Const DUALFORMAT As String = "0.00"
Dim KillFlag As Integer
Dim sMsg As String
Dim sRefPfx As String
Dim nRefNum As Long
Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
If swDoc.GetType <> swDocDRAWING Then
MsgBox "This macro only works for drawing files."
Exit Sub
End If
sMsg = "This macro will add a note of a dimension reference number " & _
vbCrLf & "to all dimensions in this drawing." & vbCrLf & vbCrLf & _
"To add or update dimension reference numbers inside ""<C#- >"", choose ""Yes""" & vbCrLf & _
"To remove all reference numbers, including the ""<C#- >"", choose ""No""" & _
vbCrLf & "To quit, choose ""Cancel"""
KillFlag = MsgBox(sMsg, vbYesNoCancel, "Dimension Reference Numbers")
If KillFlag = vbCancel Then
Exit Sub
End If
Set swDwg = swDoc
nRefNum = InputBox("Please enter the starting number")
Set swView = swDwg.GetFirstView
While Not (swView Is Nothing)
Set swDispDim = swView.GetFirstDisplayDimension5
While Not swDispDim Is Nothing
Set swDim = swDispDim.GetDimension
sInchString = sRefPfx & nRefNum
nRefNum = nRefNum + 1
sCurPrefix = swDispDim.GetText(swDimensionTextPrefix)
nOpenParPos = InStr(1, sCurPrefix, "<C#-", vbTextCompare)
nCloseParPos = InStr(1, sCurPrefix, ">", vbTextCompare)
If (KillFlag = vbNo) And (nOpenParPos > 0) And (nCloseParPos > 0) Then
sNewPrefix = Left(sCurPrefix, nOpenParPos - 1)
sNewPrefix = sNewPrefix & Right(sCurPrefix, Len(sCurPrefix) - nCloseParPos)
ElseIf (nOpenParPos > 0) And (nCloseParPos > 0) Then
sNewPrefix = Left(sCurPrefix, nOpenParPos)
sNewPrefix = sNewPrefix & sInchString
sNewPrefix = sNewPrefix & Right(sCurPrefix, Len(sCurPrefix) - (nCloseParPos - 1))
Else
If KillFlag <> vbNo Then
sNewPrefix = "<C#-" & sInchString & ">" & sCurPrefix
Else
sNewPrefix = sCurPrefix
End If
End If
swDispDim.SetText swDimensionTextPrefix, sNewPrefix
Set swDispDim = swDispDim.GetNext5
Wend
Set swView = swView.GetNextView
Wend
Set swApp = Application.SldWorks
End Sub
I am an Irish Product Design Student currently looking to speed up my current Solidworks formatting. I have been looking at macros online and have adapted a macro I found but have hit a road block. I want to write it so the macro skips over reference dimensions (Below). I have considered using different layers but have not been able to arrive to a solution as I'm very new to VBA.
Any help is much appreciated.
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swDwg As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swDispDim As SldWorks.DisplayDimension
Dim swDim As SldWorks.Dimension
Dim sCurPrefix As String
Dim nOpenParPos As Long
Dim nCloseParPos As Long
Dim vDimVal As Variant
Dim dInchVal As Double
Dim sInchString As String
Dim sNewPrefix As String
Const DUALFORMAT As String = "0.00"
Dim KillFlag As Integer
Dim sMsg As String
Dim sRefPfx As String
Dim nRefNum As Long
Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
If swDoc.GetType <> swDocDRAWING Then
MsgBox "This macro only works for drawing files."
Exit Sub
End If
sMsg = "This macro will add a note of a dimension reference number " & _
vbCrLf & "to all dimensions in this drawing." & vbCrLf & vbCrLf & _
"To add or update dimension reference numbers inside ""<C#- >"", choose ""Yes""" & vbCrLf & _
"To remove all reference numbers, including the ""<C#- >"", choose ""No""" & _
vbCrLf & "To quit, choose ""Cancel"""
KillFlag = MsgBox(sMsg, vbYesNoCancel, "Dimension Reference Numbers")
If KillFlag = vbCancel Then
Exit Sub
End If
Set swDwg = swDoc
nRefNum = InputBox("Please enter the starting number")
Set swView = swDwg.GetFirstView
While Not (swView Is Nothing)
Set swDispDim = swView.GetFirstDisplayDimension5
While Not swDispDim Is Nothing
Set swDim = swDispDim.GetDimension
sInchString = sRefPfx & nRefNum
nRefNum = nRefNum + 1
sCurPrefix = swDispDim.GetText(swDimensionTextPrefix)
nOpenParPos = InStr(1, sCurPrefix, "<C#-", vbTextCompare)
nCloseParPos = InStr(1, sCurPrefix, ">", vbTextCompare)
If (KillFlag = vbNo) And (nOpenParPos > 0) And (nCloseParPos > 0) Then
sNewPrefix = Left(sCurPrefix, nOpenParPos - 1)
sNewPrefix = sNewPrefix & Right(sCurPrefix, Len(sCurPrefix) - nCloseParPos)
ElseIf (nOpenParPos > 0) And (nCloseParPos > 0) Then
sNewPrefix = Left(sCurPrefix, nOpenParPos)
sNewPrefix = sNewPrefix & sInchString
sNewPrefix = sNewPrefix & Right(sCurPrefix, Len(sCurPrefix) - (nCloseParPos - 1))
Else
If KillFlag <> vbNo Then
sNewPrefix = "<C#-" & sInchString & ">" & sCurPrefix
Else
sNewPrefix = sCurPrefix
End If
End If
swDispDim.SetText swDimensionTextPrefix, sNewPrefix
Set swDispDim = swDispDim.GetNext5
Wend
Set swView = swView.GetNextView
Wend
Set swApp = Application.SldWorks
End Sub