''This macro wil fill in the scale of your base view in a text field or sketched symbol
''depending if you use a standard scale or a custom scale.
''Multi-sheet is also supported!

''First create 2 sketched Symbols in your drawing:
''CUSTOMSCALE & AUTOSCALE with one prompted text field named Scale
''Second, create a custom property Scale in your titleblock.

''Macro created by Stefaan Boel
''Copyright by Inventor Wizard (http://www.inventorwizard.be)
''Use this macro at your own risk.
''You may only copy/modify this or part of the code if you leave this header!


Sub Save_Scale()

Dim oDrawDoc As Inventor.Document
Dim oSheet As Sheet
Dim oView As DrawingView
Dim sScale As String
Dim dScale As Double
Dim oSketchedSymbol As SketchedSymbol

Dim bUseAutoScale As Boolean
Dim bAutoScaleFound As Boolean
Dim bCustomScaleFound As Boolean
Dim ScaleExist As Boolean
Dim Custom As Boolean
Dim intDummy As InferredTypeEnum
Dim SheetCount As Integer
Dim strMsg As String

' Check to see if there is a drawing active if not: Error message
' Else continue the code

Set oDrawDoc = ThisApplication.ActiveDocument

If oDrawDoc.DocumentType = kDrawingDocumentObject Then


If Err Then
intDummy = MsgBox("Open a drawing before running this macro!", vbExclamation, "No drawing open")
Exit Sub
End If

For Each oSheet In oDrawDoc.Sheets
On Error Resume Next
Set oView = oSheet.DrawingViews.Item(1)

If Err Then 'There is not a DrawingView on this sheet...

strMsg = "No Base View on" & " " & (oSheet.Name) & " " & "found, place a Base View first!"
intDummy = MsgBox(strMsg, vbExclamation, "No Base View")
Err.Clear
GoTo NoDrawingViewFound 'Go to the end of the program
End If

'Set scale of the view to dScale
'Scale has the size x,x
dScale = oView.Scale

bUseAutoScale = True
ScaleExist = True
Custom = False

'Convert the scale to our standard way of printing

Select Case dScale
Case 1
sScale = "1:1"
Case 0.5
sScale = "1:2"
Case 0.2
sScale = "1:5"
Case 0.1
sScale = "1:10"
Case 0.05
sScale = "1:20"
Case 0.02
sScale = "1:50"
Case 0.01
sScale = "1:100"
Case 2
sScale = "2:1"
Case 5
sScale = "5:1"
Case 10
sScale = "10:1"
Case Else
bUseAutoScale = False 'With this view we can't put a AutoScale symbol, since scale is not standard
Custom = True 'We need to place custom scale symbol

End Select

' Get the custom property sets.
Dim oCustomSet As PropertySet
Set oCustomSet = ThisApplication.ActiveDocument.PropertySets.Item("Inventor User Defined Properties")

' Check to see if the custom property named "Scale" exists.
' If it does exist update the value.
' On Error Resume Next

Set oScaleProperty = oCustomSet.Item("Scale")
If Err Then
ScaleExist = False
Else
ScaleExits = True
End If

SheetCount = oDrawDoc.Sheets.Count

' If scale is standard and Scale property does not exist, do this:
If (bUseAutoScale = True And ScaleExits = False) Or (SheetCount > 1 And bUseAutoScale = True) Then
bAutoScaleFound = False
' Search for the AUTOSCALE Sketched Symbol...
For Each oSketchedSymbol In oSheet.SketchedSymbols
If oSketchedSymbol.Definition.Name = "AUTOSCALE" Then
'AutoScale Sketched Symbol Found
Call oSketchedSymbol.SetPromptResultText(oSketchedSymbol.Definition.Sketch.TextBoxes(1), sScale) ' The second TextBox of this SketchedSymbol contains the Prompted Text
bAutoScaleFound = True
Exit For
End If
Next oSketchedSymbol

' Autoscale symbol not found and Scale property does not exist:
If (bAutoScaleFound = False And ScaleExits = False) Or (SheetCount > 1 And bAutoScaleFound = False) Then
strMsg = "No AutoScale Sketched Symbol found on sheet '" & oSheet.Name & "'."
intDummy = MsgBox(strMsg, vbExclamation, "No Base View")
End If
Else ' There should be a Custom Scale
bCustomScaleFound = False
' Search for the CUSTOMSCALE Sketched Symbol...
For Each oSketchedSymbol In oSheet.SketchedSymbols
If oSketchedSymbol.Definition.Name = "CUSTOMSCALE" Then
'MsgBox "CUSTOMScale Sketched Symbol Found"
bCustomScaleFound = True
Custom = False
Exit For
End If
Next oSketchedSymbol
End If

'Custom scale necessary but no Custom scale symbol found and Scale property does not exist
If bCustomScaleFound = False And ScaleExits = False Or Custom = True Then
strMsg = "'" & oSheet.Name & "' does not use a standard scale" & (Chr(13)) & "Place a CUSTOMSCALE sketched symbol to insert a Custom Scale!" & (Chr(13)) & (Chr(13)) & "Standard Scales are: 1:1, 1:2, 1:5, 1:10, 1:20, 1:50, 1:100, 2:1, 5:1, 10:1"
intDummy = MsgBox(strMsg, vbExclamation, "No Base View")
End If


' Check to see if the custom property named "Scale" exists.
' If it does exist update the value.
On Error Resume Next

Set oScaleProperty = oCustomSet.Item("Scale")
If Err Then
' Force the title block to update.
ThisApplication.ActiveDocument.Update
Else
SheetCount = oDrawDoc.Sheets.Count
'MsgBox "how many sheets are there? " & (Chr(13)) & SheetCount
If SheetCount = 1 Then
' Update the value of the existing property.
oScaleProperty.Value = sScale
' Force the title block to update.
ThisApplication.ActiveDocument.Update
Else
oScaleProperty.Value = " "
' Force the title block to update.
ThisApplication.ActiveDocument.Update
End If
End If

NoDrawingViewFound:

Next oSheet
End If

End Sub