6 Replies Latest reply on Sep 26, 2014 1:21 AM by Tore Magne Bjornodegard

    Macro for quick and easy scaling in drawings

    Tore Magne Bjornodegard

      Hi,

      I have made macro to make it easier and faster to set scale to my drawing views. Works by selecting view you want to scale and starting sub ScaleUp or ScaleDown, if no view is selected sheet scale is set either up or down. Simple as that.

       

      '-----------------------------
      '
      'QuickScale By Tore Magne Bjørnødegård
      '
      '
      'If view is selected:
      'Selected view is set to use "custom scale", and scaled up or down.
      '
      'If no view is selected:
      '"sheet scale" is scaled up or down.
      '
      'Feel free to do the changes You like.
      '
      '-------------------------------
      Dim swApp           As SldWorks.SldWorks
      Dim swModel         As SldWorks.ModelDoc2
      Dim swDraw          As SldWorks.DrawingDoc
      Dim swSelMgr        As SldWorks.SelectionMgr
      Dim swView          As SldWorks.View
      Dim Part            As DrawingDoc
      Dim currentSheet    As Sheet
      Dim vScaleRatio     As Variant
      Dim boolstatus      As Boolean
      Dim ScaleBy         As Integer
      
      
      
      
      Sub ScaleUp()
      
      
      ScaleBy = 1
      
      
          Set swApp = Application.SldWorks
      
      
          Set swModel = swApp.ActiveDoc
      
      
          Set swDraw = swModel
      
      
          Set swSelMgr = swModel.SelectionManager
      
      
          If swSelMgr.GetSelectedObjectType2(1) = 12 Then
          
              Call SetViewScale
          
          Else
          
              Call SetSheetScale
          
          End If
      
      
      End Sub
      
      
      Sub ScaleDown()
      
      
      ScaleBy = -1
      
      
          Set swApp = Application.SldWorks
      
      
          Set swModel = swApp.ActiveDoc
      
      
          Set swDraw = swModel
      
      
          Set swSelMgr = swModel.SelectionManager
      
      
          If swSelMgr.GetSelectedObjectType2(1) = 12 Then
          
              Call SetViewScale
          
          Else
          
              Call SetSheetScale
          
          End If
      
      
      
      
      
      
      End Sub
      
      
      
      
      
      
      Sub SetSheetScale()
      
      
      
      
          Set swApp = Application.SldWorks
      
      
      
      
          Set Part = swApp.ActiveDoc
      
      
      
      
          Set currentSheet = Part.GetCurrentSheet
          
          vScaleRatio = currentSheet.GetProperties
         
          'Debug.Print ("Scale = " & vScaleRatio(2) & " : " & vScaleRatio(3))
          
          If vScaleRatio(3) >= 30 Then
          
              ScaleBy = ScaleBy * 10
          
          ElseIf vScaleRatio(3) >= 10 Then
          
              ScaleBy = ScaleBy * 5
          
          End If
      
      
          If vScaleRatio(2) = vScaleRatio(3) Then
          
              If ScaleBy > 0 Then
                  
                  boolstatus = currentSheet.SetScale((vScaleRatio(2) + ScaleBy), vScaleRatio(3), True, False)
                  
              Else
              
                  boolstatus = currentSheet.SetScale(vScaleRatio(2), (vScaleRatio(3) - ScaleBy), True, False)
                  
              End If
          
          ElseIf vScaleRatio(2) < vScaleRatio(3) Then
          
              boolstatus = currentSheet.SetScale(vScaleRatio(2), (vScaleRatio(3) - ScaleBy), True, False)
          
          ElseIf vScaleRatio(2) > vScaleRatio(3) Then
          
              boolstatus = currentSheet.SetScale((vScaleRatio(2) + ScaleBy), vScaleRatio(3), True, False)
          
          End If
      
          
        
      
      
      End Sub
      
      
      Sub SetViewScale()
      
      
          Set swApp = Application.SldWorks
      
      
          Set swModel = swApp.ActiveDoc
      
      
          Set swDraw = swModel
      
      
          Set swSelMgr = swModel.SelectionManager
          
          Set swView = swSelMgr.GetSelectedObject5(1)
      
      
          
          vScaleRatio = swView.ScaleRatio
         
          'Debug.Print ("Scale = " & vScaleRatio(0) & " : " & vScaleRatio(1))
          
              If vScaleRatio(1) >= 30 Then
          
              ScaleBy = ScaleBy * 10
          
          ElseIf vScaleRatio(1) >= 10 Then
          
              ScaleBy = ScaleBy * 5
          
          End If
      
      
          If vScaleRatio(0) = vScaleRatio(1) Then
          
              If ScaleBy > 0 Then
                              
                  swView.ScaleDecimal = (vScaleRatio(0) + ScaleBy) / vScaleRatio(1)
                  
              Else
                         
                  swView.ScaleDecimal = vScaleRatio(0) / (vScaleRatio(1) - ScaleBy)
                  
              End If
          
          ElseIf vScaleRatio(0) < vScaleRatio(1) Then
                  
              swView.ScaleDecimal = vScaleRatio(0) / (vScaleRatio(1) - ScaleBy)
              
          ElseIf vScaleRatio(0) > vScaleRatio(1) Then
          
              swView.ScaleDecimal = (vScaleRatio(0) + ScaleBy) / vScaleRatio(1)
          
          End If
      
          
          boolstatus = swModel.EditRebuild
      
      
      End Sub