AnsweredAssumed Answered

Detecting dimension value thats not <DIM>

Question asked by Chris Manger on Sep 15, 2011
Latest reply on Jul 27, 2015 by Bryan Obermeyer

I know the design checker checks for Override Value but what about if someone types a value in the "Dimension Text" box, removing the <DIM> and replacing it with their number for text.

 

I found the macro below that detects if the Override Value is changed but what about if the "Dimension Text" has been changed?

 

override-value.jpg

 

 

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 sCurSuffix 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
Dim sNewSuffix As String
Dim KillFlag As Integer
Dim sMsg As String


Sub AddStarToOverridden()

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 prefix and suffix of ""*""" & _
        vbCrLf & "to all overridden dimensions in this drawing." & _
        vbCrLf & vbCrLf & _
        "To add or update stars on overridden dimensions, choose ""Yes""" & vbCrLf & _
        "To remove all stars, choose ""No""" & _
        vbCrLf & "To quit, choose ""Cancel"""
KillFlag = MsgBox(sMsg, vbYesNoCancel, "Add stars?")

If KillFlag = vbCancel Then
    Exit Sub
End If


Set swDwg = swDoc


Set swView = swDwg.GetFirstView
While Not (swView Is Nothing)
    Set swDispDim = swView.GetFirstDisplayDimension5
    While Not swDispDim Is Nothing
        Set swDim = swDispDim.GetDimension
        sCurSuffix = swDispDim.GetText(swDimensionTextSuffix)
        sCurPrefix = swDispDim.GetText(swDimensionTextPrefix)
        
        If (swDispDim.GetOverride) And (KillFlag = vbYes) Then
            If Right(sCurPrefix, 1) <> "*" Then
                sNewPrefix = sCurPrefix & "*"
            Else
                sNewPrefix = sCurPrefix
            End If
            If Left(sCurSuffix, 1) <> "*" Then
                sNewSuffix = "*" & sCurSuffix
            Else
                sNewSuffix = sCurSuffix
            End If
        Else
            If Right(sCurPrefix, 1) = "*" Then
                sNewPrefix = Left(sCurPrefix, Len(sCurPrefix) - 1)
            Else
                sNewPrefix = sCurPrefix
            End If
            If Left(sCurSuffix, 1) = "*" Then
                sNewSuffix = Right(sCurSuffix, Len(sCurSuffix) - 1)
            Else
                sNewSuffix = sCurSuffix
            End If
        End If

        swDispDim.SetText swDimensionTextSuffix, sNewSuffix
        swDispDim.SetText swDimensionTextPrefix, sNewPrefix
        
        Set swDispDim = swDispDim.GetNext5
    Wend
    Set swView = swView.GetNextView
Wend


End Sub

Outcomes