ds-blue-logo
Preview  |  SOLIDWORKS USER FORUM
Use your SOLIDWORKS ID or 3DEXPERIENCE ID to log in.
CMChris Manger15/09/2011

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