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.)
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.
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
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
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
This works. (The only change is swApp.SetUserPreference… changes to Part.SetUserPreference…)
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