JonathanESeiler wrote:
However, when there is only one scale, it does not input the scale in the title block like the original code did.
Also, When triggering the rule again on a blank sheet, the scale noted remains "Varies"
Hi JonathanESeiler,
I tested for both of these conditions and fixed the error that occurred when no view was found on a sheet, but I could not replicate the case where the code did not input the scale in the title block when there is only one scale.
I might have been that a sheet with not views was causing the problem, and fixing that, fixed both issues, but let me know if this revised version still does not work as expected.
I hope this helps.
Best of luck to you in all of your Inventor pursuits,
Curtis
http://inventortrenches.blogspot.com
Sub Main
'this rule expects a prompted entry
'in the title block with the value of: <Scale>
Dim oDrawdoc As DrawingDocument
oDrawdoc = ThisApplication.ActiveDocument
iLogicVb.UpdateWhenDone = True
Dim oSheet As Sheet
Dim oTitleBlock As TitleBlock
Dim oView As DrawingView
Dim dScale As Double
Dim sScale As String
Dim oScaleText As TextBox
Dim oScaleString As String
oScaleString = String.Empty
'get current sheet
curSheet = oDrawdoc.ActiveSheet
For Each oSheet In oDrawdoc.Sheets
'get first view scale
Try
dScale = oSheet.DrawingViews.Item(1).Scale
Catch
End Try
'get the title block
oTitleBlock = oSheet.TitleBlock
If (oTitleBlock Is Nothing) Then Continue For
oScaleText = GetScaleTextBox(oTitleBlock.Definition)
If (oScaleText Is Nothing) Then Continue For
For Each oView In oSheet.DrawingViews
If dScale <> oView.Scale Then
oScaleString = "Varies"
Exit For
Else
oScaleString = oView.ScaleString
End If
Next
oTitleBlock.SetPromptResultText(oScaleText, oScaleString)
Next
'return to original sheet
curSheet.Activate
End Sub
Function GetScaleTextBox(ByVal titleDef As TitleBlockDefinition) As TextBox
For Each defText As TextBox In titleDef.Sketch.TextBoxes
If (defText.Text = "<Scale>" Or defText.Text = "Scale") Then
Return defText
End If
Next
Return Nothing
End Function
