Macro for quick and easy scaling in drawings

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.

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