AnsweredAssumed Answered

Macro to change View and/or Sheet Scale

Question asked by Leon Wurr on Apr 30, 2015
Latest reply on Sep 24, 2019 by Artem Taturevych

Hello,

 

     I've put together this macro to change the scales on drawings. If a view is selected, it changes the view scale only, if nothing is selected, it changes the sheet scale.

    

     I created macro buttons in the "View Layout" tab and added keyboard shortcuts to it:

     Scale_Macro_Example.png

 

     Just wanted to share. I'm attaching the macros and the .bmp files of the buttons in this thread in case anyone is interested.

    

     The idea came when reading this thread: macro to change sheet scale

 

Dim swApp                       As SldWorks.SldWorks

Dim swModel                     As SldWorks.ModelDoc2

Dim swSelMgr                    As SldWorks.SelectionMgr

Dim swView                      As SldWorks.View

Dim boolstatus                  As Boolean

Dim currentSheet                As Sheet

Dim swDraw                      As SldWorks.DrawingDoc

Dim X                           As Integer

Dim Y                           As Integer

Dim swScale                     As Double

Dim bRet                        As Boolean

 

Sub main()

    X = 1                                                  'The scale will be set as X:Y

    Y = 1

    Debug.Print "Scale          = " & X & ":" & Y

    swScale = X / Y

    Debug.Print "swScale          = "; swScale

 

 

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swSelMgr = swModel.SelectionManager

    Set currentSheet = swModel.GetCurrentSheet

    On Error Resume Next

    Set swView = swSelMgr.GetSelectedObject6(1, -2)

    If Not swView Is Nothing Then

        swView.ScaleDecimal = swScale

        bRet = swDraw.ForceRebuild3(False)

        Else

        boolstatus = currentSheet.SetScale(X, Y, True, False)

        bRet = swDraw.ForceRebuild3(False)

    End If

    swModel.ClearSelection2 False

    swModel.ForceRebuild3 False

    bRet = swDraw.ForceRebuild3(False)

End Sub

Attachments

Outcomes