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