Macro to Set Document Property

[SPerman]

I am attempting to create a macro to change a document property. Specifically I want to turn off "Automatically jog ordinates" for ordinate dimensions. I've changed my template, but I've got a couple of hundred drawings out there that need to have this setting changed. (I'm not a formally trained programmer, just an engineer trying his best.)

I've found these resources:
https://help.solidworks.com/2020/englis ... Redirect=1
https://help.solidworks.com/2020/englis ... Redirect=1
https://help.solidworks.com/2020/englis ... Redirect=1

Based on what I read from those, this is the code I've written. I can't find a specific example of making this change, but I've tried to copy similar examples. It runs, but the value doesn't change.

Code: Select all

Option Explicit

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim ModelDocExtension As ModelDocExtension

Sub NoAutoJog()

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set ModelDocExtension = Part.Extension

boolstatus = swApp.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingDimsAutoJogOrdinates, "False")

End Sub

[AlexB]

That command works to uncheck the option in the Settings menu, but it has to be called from the IModelDoc2::IModelDocExtension::SetUserPreferenceToggle.
However that doesn't affect any of the current dimensions on the drawing. If you want to un-jog those, you could use this.

Edit: The script un-checks the option in the menu then un-jogs all display dimensions on the current sheet

Code: Select all

Option Explicit

Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDraw As DrawingDoc
    Dim swView As SldWorks.View
    Dim allSheetViewArrays As Variant
    Dim sheetViews As Variant
    Dim swDispDim As DisplayDimension
    Dim swAnno As Annotation
    Dim Msg As String
    Dim Style As Integer
    Dim Title As String
    Dim i As Integer
    Dim j As Integer
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    'This command un-checks the option in the Document Properties Menu
    swModel.Extension.SetUserPreferenceToggle swUserPreferenceToggle_e.swDetailingDimsAutoJogOrdinates, swUserPreferenceOption_e.swDetailingNoOptionSpecified, False
    
    
    ' All of the following un-jogs existing dimensions
    If swModel.GetType <> swDocDRAWING Then
        Msg = "Only Allowed on Drawings" ' Define message
        Style = vbOKOnly ' OK Button only
        Title = "Error" ' Define title
        Call MsgBox(Msg, Style, Title) ' Display error message
        Exit Sub ' Exit this program
    End If
        
    Set swDraw = swModel
    allSheetViewArrays = swDraw.GetViews
    For i = 0 To UBound(allSheetViewArrays)
        sheetViews = allSheetViewArrays(i)
        For j = 0 To UBound(sheetViews)
            Set swView = sheetViews(j)
                Set swAnno = swView.GetFirstAnnotation2
                Do While Not swAnno Is Nothing
                    If swAnno.GetType = swDisplayDimension Then
                        Set swDispDim = swAnno.GetSpecificAnnotation
                        If swDispDim.Type2 = swDimensionType_e.swOrdinateDimension Then
                            swDispDim.Jogged = False
                        End If
                    End If
                    Set swAnno = swAnno.GetNext
                Loop
            Set swView = swView.GetNextView
        Next j
    Next i
    swModel.GraphicsRedraw2
End Sub

[SPerman]

The code I supplied doesn't work, but thanks to this thread I figured it out. (Should I be surprised that the example posted by DSS doesn't work?)

https://www.cadforum.net/viewtopic.php?t=1916 (Thanks to @alexb and @steph)

This works. (The only change is swApp.SetUserPreference... changes to Part.SetUserPreference....)

Code: Select all

Option Explicit

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim ModelDocExtension As ModelDocExtension

Sub NoAutoJog()

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set ModelDocExtension = Part.Extension

boolstatus = Part.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingDimsAutoJogOrdinates, "False")

End Sub