Dimensioning Problems

[Ripper2009]

Hi all.

Its almost the end of the day Friday and Im back bothering you again.
Ok...here goes...
Here’s what I know about SolidWorks dimension names so far:
1. SolidWorks generates a name for each dimension, which is based on the sketch or feature in which it appears, such as
“D1@Sketch1”.
2. Dimension names can be displayed on a drawing by selecting “Show dimension names” in the System options window.
However, the “Show dimension names” option does not actually display the full name - you only get “D1”, not
“D1@Sketch1”.
Our goal is to have a unique name generated automatically by SolidWorks for every dimension on the drawing. The problem I’ve
encountered is that there could be 10 sketches/features for a part, and for each one the first dimension will be “D1”. Therefore, you’re
going to see 10 dimensions labeled “D1” on the drawing. (I know you can click on a dimension and manually change its name, but we
really don’t want to do that.)
So here’s what I’d like to know:
1. Is there a way to have SolidWorks show the full dimension name? (This would make each dimension name unique.)
2. If it’s not possible to see the full name, is there a way to change how the dimensions are named? For example, instead of
starting at “D1” for every sketch/feature, it would be nice to have SolidWorks continue from where the last
sketch/feature left off - if the last dimension name in Sketch1 is “D5”, how about the first dimension name in Sketch2
being “D6” (instead of “D1” again)?
3. Is there a way to control where the dimension name appears? By default, it appears below the dimension value – can this
be changed?
I would greatly appreciate any assistance you can provide in regard to these issues.


Thanks,

Rip


SolidWorks 2007
SP 4.0

 

[handleman]

I added a couple of lines to the macro I linked to previously. Now when run, it will rename every dimension on the drawing sheet with your chosen prefix and a sequential number. Enjoy!

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 swTol As SldWorks.DimensionTolerance
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlBooks As Excel.Workbooks
Dim CurRow As Long
Const STARTROW As Long = 3
Const DIMNAMECOL As Long = 2
Const DIMVALCOL As Long = 3
Const DIMTOLTYPECOL As Long = 4
Const DIMUPPERTOLVALCOL As Long = 5
Const DIMLOWERTOLVALCOL As Long = 6
Const DIMTOLFITCLASSCOL As Long = 7
Const TOLSCALEFACTOR As Double = 1000





Sub RenameAndExportDims()

Dim NumTolVals As Integer
Dim TolIsFit As Boolean
Dim DimNamePfx As String
Dim DimNameIndex 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

DimNamePfx = InputBox("Please enter the desired dimension name prefix")
If UCase(DimNamePfx) = "D" Or DimNamePfx = "" Then
    MsgBox "Prefix not acceptable - aborting"
    Exit Sub
End If

DimNameIndex = 1

Set swDwg = swDoc
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBooks = xlApp.Workbooks
xlBooks.Add
Set xlSheet = xlApp.ActiveSheet
CurRow = STARTROW
xlSheet.Cells(CurRow, DIMNAMECOL).Value = "Dimension Name"
xlSheet.Cells(CurRow, DIMVALCOL).Value = "Nominal Value"
xlSheet.Cells(CurRow, DIMTOLTYPECOL).Value = "Tolerance Type"
xlSheet.Cells(CurRow, DIMUPPERTOLVALCOL).Value = "Upper Tol"
xlSheet.Cells(CurRow, DIMLOWERTOLVALCOL).Value = "Lower Tol"
xlSheet.Cells(CurRow, DIMTOLFITCLASSCOL).Value = "Fit Class (Hole/shaft)"
CurRow = CurRow + 1

Set swView = swDwg.GetFirstView
While Not (swView Is Nothing)
    Set swDispDim = swView.GetFirstDisplayDimension5
    While Not swDispDim Is Nothing
        Set swDim = swDispDim.GetDimension
        swDim.Name = DimNamePfx & DimNameIndex
        DimNameIndex = DimNameIndex + 1
        Set swTol = swDim.Tolerance
        xlSheet.Cells(CurRow, DIMNAMECOL).Value = swDim.FullName
        xlSheet.Cells(CurRow, DIMVALCOL).Value = swDim.Value
        xlSheet.Cells(CurRow, DIMTOLTYPECOL).Value = GetTolTypeName(swTol, NumTolVals, TolIsFit)
        If NumTolVals > 0 Then
            xlSheet.Cells(CurRow, DIMUPPERTOLVALCOL).Value = swTol.GetMaxValue * TOLSCALEFACTOR
        End If
        If NumTolVals > 1 Then
            xlSheet.Cells(CurRow, DIMLOWERTOLVALCOL).Value = swTol.GetMinValue * TOLSCALEFACTOR
        End If
        If TolIsFit Then xlSheet.Cells(CurRow, DIMTOLFITCLASSCOL).Value = swTol.GetHoleFitValue & "/" & swTol.GetShaftFitValue
        Set swDispDim = swDispDim.GetNext5
        CurRow = CurRow + 1
    Wend
    Set swView = swView.GetNextView
Wend

xlApp.Range("A:Z").EntireColumn.AutoFit
End Sub

Function GetTolTypeName(ByRef myTol As SldWorks.DimensionTolerance, ByRef NumVals As Integer, ByRef FitTol As Boolean) As String
Dim s As String
FitTol = False
Select Case myTol.Type
    Case swTolNONE
        s = "None"
        NumVals = 0
    Case swTolBASIC
        s = "Basic"
        NumVals = 0
    Case swTolBILAT
        s = "Bilateral"
        NumVals = 2
    Case swTolLIMIT
        s = "Limit"
        NumVals = 2
    Case swTolSYMMETRIC
        s = "Symmetric"
        NumVals = 1
    Case swTolMIN
        s = "Minimum"
        NumVals = 0
    Case swTolMAX
        s = "Maximum"
        NumVals = 0
    Case swTolMETRIC
        s = "Metric"
        NumVals = 2
    Case swTolFIT
        s = "Fit"
        NumVals = 0
        FitTol = True
    Case swTolFITWITHTOL
        s = "Fit With Tolerance"
        NumVals = 2
        FitTol = True
    Case swTolFITTOLONLY
        s = "Fit, Tolerance Only"
        NumVals = 2
        FitTol = False
    Case swTolBLOCK
        s = "Block"
        NumVals = 2
        FitTol = False
End Select
GetTolTypeName = s
End Function

 

[handleman]

Here's another way to do it. This macro will add a reference number to all dimensions as a text suffix inside square brackets ([]). Please note that if the macro is run again the new numbers will likely not match the old ones. The previous macro I posted will also exhibit such behavior. If you do use either of these macros, you probably want to wait until the drawing is ready for issue before running. Note that this macro doesn't do the dim export to Excel as the previous one did.

Enjoy!

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 sCurSuffix As String
Dim nOpenParPos As Long
Dim nCloseParPos As Long
Dim vDimVal As Variant
Dim dInchVal As Double
Dim sInchString As String
Dim sNewSuffix As String
Const DUALFORMAT As String = "0.00"
Dim KillFlag As Integer
Dim sMsg As String
Dim sRefPfx As String
Dim nRefNum As Long


Sub AddDimRefNums()

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 text suffix of a dimension reference number " & _
        vbCrLf & "to all dimensions in this drawing." & vbCrLf & vbCrLf & _
        "To add or update dimension reference numbers inside ""[ ]"", choose ""Yes""" & vbCrLf & _
        "To remove all reference numbers, including the ""[ ]"", choose ""No""" & _
        vbCrLf & "To quit, choose ""Cancel"""
KillFlag = MsgBox(sMsg, vbYesNoCancel, "Dimension Reference Numbers")

If KillFlag = vbCancel Then
    Exit Sub
End If

sRefPfx = InputBox("Please enter the reference prefix")

Set swDwg = swDoc

nRefNum = 1

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
        sCurSuffix = swDispDim.GetText(swDimensionTextSuffix)
        nOpenParPos = InStr(1, sCurSuffix, "[", vbTextCompare)
        nCloseParPos = InStr(1, sCurSuffix, "]", vbTextCompare)
        If (KillFlag = vbNo) And (nOpenParPos > 0) And (nCloseParPos > 0) Then
            sNewSuffix = Left(sCurSuffix, nOpenParPos - 1)
            sNewSuffix = sNewSuffix & Right(sCurSuffix, Len(sCurSuffix) - nCloseParPos)
        ElseIf (nOpenParPos > 0) And (nCloseParPos > 0) Then
            sNewSuffix = Left(sCurSuffix, nOpenParPos)
            sNewSuffix = sNewSuffix & sInchString
            sNewSuffix = sNewSuffix & Right(sCurSuffix, Len(sCurSuffix) - (nCloseParPos - 1))
        Else
            If KillFlag <> vbNo Then
                sNewSuffix = "[" & sInchString & "] " & sCurSuffix
            Else
                sNewSuffix = sCurSuffix
            End If
        End If
        swDispDim.SetText swDimensionTextSuffix, sNewSuffix
        Set swDispDim = swDispDim.GetNext5
    Wend
    Set swView = swView.GetNextView
Wend


End Sub