Add Scale to Titleblock for first view on each drawing sheet on single .idw

[Shag_Bore]

I am trying to develop a rule to ad the scale from the 1st view on each drawing sheet in a single .idw to the titleblock. I typically have up to 8 sheets per .idw so I made the rule go up to 10 sheets. I have the 1st part working if I suppress the rule where the sheets don't exist. The 1st part of the rule is going to create an custom iProperty called Scale1, Scale2, etc..the number will match the sheet number.

How would I correct the code so that it will work correctly if there are sheets that don't exist. 

Public Sub Main()


  On Error Resume Next
  'Get the drawing document
  Dim oDrawingDoc As Inventor.DrawingDocument
  oDrawingDoc = ThisApplication.ActiveDocument
  'Dim oErrResponse As VbMsgBoxResult
  If Err.number <> 0 Then
    MsgBox("Active document must be a drawing", vbExclamation, "Error")
    Exit Sub
  End If
 
  'Sheet 1 - get scale from 1st view
  Dim oSheet1 As Inventor.Sheet
  oSheet1 = oDrawingDoc.Sheets.Item(1)
  
 		 'Sheet 1 - Get the first view
  		Dim oView1 As Inventor.DrawingView
  		oView1 = oSheet1.DrawingViews.Item(1)
  		If Err.number <> 0 Then
    	Resume Next
    	Exit Sub
  		End If		

				'Sheet 1 - Get the view scale string
  				Dim sScaleText1 As String
  				sScaleText1 = oView1.ScaleString
  
 
	'Sheet 2 - get scale from 1st view
  	Dim oSheet2 As Inventor.Sheet
  	oSheet2 = oDrawingDoc.Sheets.Item(2)
  
  		'Sheet 2 - Get the first view
  		Dim oView2 As Inventor.DrawingView
  		oView2 = oSheet2.DrawingViews.Item(1)
  		If Err.number <> 0 Then
    	Resume Next
    	Exit Sub
  		End If		

				'Sheet - 2 Get the view scale string
  				Dim sScaleText2 As String
  				sScaleText2 = oView2.ScaleString
  
 	'Sheet 3 - get scale from 1st view
  	Dim oSheet3 As Inventor.Sheet
  	oSheet3 = oDrawingDoc.Sheets.Item(3)
  
  		'Sheet 3 - Get the first view
  		Dim oView3 As Inventor.DrawingView
  		oView3 = oSheet3.DrawingViews.Item(1)
  		If Err.number <> 0 Then
    	Resume Next
    	Exit Sub
  		End If		

				'Sheet - 3 Get the view scale string
  				Dim sScaleText3 As String
  				sScaleText3 = oView3.ScaleString
 
  	'Sheet 4 - get scale from 1st view
  	Dim oSheet4 As Inventor.Sheet
  	oSheet4 = oDrawingDoc.Sheets.Item(4)
  
  		'Sheet 4 - Get the first view
  		Dim oView4 As Inventor.DrawingView
  		oView4 = oSheet4.DrawingViews.Item(1)
  		If Err.number <> 0 Then
    	Resume Next
    	Exit Sub
  		End If				

				'Sheet - 4 Get the view scale string
  				Dim sScaleText4 As String
  				sScaleText4 = oView4.ScaleString

  	'Sheet 5 - get scale from 1st view
  	Dim oSheet5 As Inventor.Sheet
  	oSheet5 = oDrawingDoc.Sheets.Item(5)
  
  		'Sheet 5 - Get the first view
  		Dim oView5 As Inventor.DrawingView
  		oView5 = oSheet5.DrawingViews.Item(1)
  		If Err.number <> 0 Then
    	Resume Next
    	Exit Sub
  		End If				

				'Sheet - 5 Get the view scale string
  				Dim sScaleText5 As String
  				sScaleText5 = oView5.ScaleString
				
	'Sheet 6 - get scale from 1st view
  	Dim oSheet6 As Inventor.Sheet
  	oSheet6 = oDrawingDoc.Sheets.Item(6)
  
  		'Sheet 6 - Get the first view
  		Dim oView6 As Inventor.DrawingView
  		oView6 = oSheet6.DrawingViews.Item(1)
  		If Err.number <> 0 Then
    	Resume Next
    	Exit Sub
  		End If				

				'Sheet - 6 Get the view scale string
  				Dim sScaleText6 As String
  				sScaleText6 = oView6.ScaleString
 
'  'Sheet 7 - get scale from 1st view
'  	Dim oSheet7 As Inventor.Sheet
'  	oSheet7 = oDrawingDoc.Sheets.Item(7)
'  
'  		'Sheet 7 - Get the first view
'  		Dim oView7 As Inventor.DrawingView
'  		oView7 = oSheet7.DrawingViews.Item(1)
'  		If Err.number <> 0 Then
'    	Resume Next
'    	Exit Sub
'  		End If				
'
'				'Sheet - 7 Get the view scale string
'  				Dim sScaleText7 As String
'  				sScaleText7 = oView7.ScaleString
'				
'	'Sheet 8 - get scale from 1st view
'  	Dim oSheet8 As Inventor.Sheet
'  	oSheet8 = oDrawingDoc.Sheets.Item(8)
'  
'  		'Sheet 8 - Get the first view
'  		Dim oView8 As Inventor.DrawingView
'  		oView8 = oSheet8.DrawingViews.Item(1)
'  		If Err.number <> 0 Then
'    	Resume Next
'    	Exit Sub
'  		End If				
'
'				'Sheet - 8 Get the view scale string
'  				Dim sScaleText8 As String
'  				sScaleText8 = oView8.ScaleString
'  
'  'Sheet 9 - get scale from 1st view
'  	Dim oSheet9 As Inventor.Sheet
'  	oSheet9 = oDrawingDoc.Sheets.Item(9)
'  
'  		'Sheet 9 - Get the first view
'  		Dim oView9 As Inventor.DrawingView
'  		oView9 = oSheet9.DrawingViews.Item(1)
'  		If Err.number <> 0 Then
'    	Resume Next
'    	Exit Sub
'  		End If				
'
'				'Sheet - 9 Get the view scale string
'  				Dim sScaleText9 As String
'  				sScaleText9 = oView9.ScaleString
'				
'	'Sheet 10 - get scale from 1st view
'  	Dim oSheet10 As Inventor.Sheet
'  	oSheet10 = oDrawingDoc.Sheets.Item(10)
'  
'  		'Sheet 10 - Get the first view
'  		Dim oView10 As Inventor.DrawingView
'  		oView10 = oSheet10.DrawingViews.Item(1)
'  		If Err.number <> 0 Then
'    	Resume Next
'    	Exit Sub
'  		End If				
'
'				'Sheet - 10 Get the view scale string
'  				Dim sScaleText10 As String
'  				sScaleText10 = oView10.ScaleString
  
  
  'Get the custom propertyset
 Dim oCustomPropSet As Inventor.PropertySet
 oCustomPropSet = oDrawingDoc.PropertySets.Item("Inventor User Defined Properties")
  
  'Get the "Scale" custom iproperty.  If it doesn't exist, we'll create it
  Dim oScaleProp1 As Inventor.Property
  oScaleProp1 = oCustomPropSet.Item("Scale1")
  If Err.number <> 0 Then
  oScaleProp1 = oCustomPropSet.Add("", "Scale1")
  End If
  oScaleProp1.Value = sScaleText1
  
    Dim oScaleProp2 As Inventor.Property
  oScaleProp2 = oCustomPropSet.Item("Scale2")
  If Err.number <> 0 Then
  oScaleProp2 = oCustomPropSet.Add("", "Scale2")
  End If
  oScaleProp2.Value = sScaleText2
  
    Dim oScaleProp3 As Inventor.Property
  oScaleProp3 = oCustomPropSet.Item("Scale3")
  If Err.number <> 0 Then
  oScaleProp3 = oCustomPropSet.Add("", "Scale3")
  End If
  oScaleProp3.Value = sScaleText3
  
    Dim oScaleProp4 As Inventor.Property
  oScaleProp4 = oCustomPropSet.Item("Scale4")
  If Err.number <> 0 Then
  oScaleProp4 = oCustomPropSet.Add("", "Scale4")
  End If
  oScaleProp4.Value = sScaleText4
  
    Dim oScaleProp5 As Inventor.Property
  oScaleProp5 = oCustomPropSet.Item("Scale5")
  If Err.number <> 0 Then
  oScaleProp5 = oCustomPropSet.Add("", "Scale5")
  End If
  oScaleProp5.Value = sScaleText5
  
    Dim oScaleProp6 As Inventor.Property
  oScaleProp6 = oCustomPropSet.Item("Scale6")
  If Err.number <> 0 Then
  oScaleProp6 = oCustomPropSet.Add("", "Scale6")
  End If
  oScaleProp6.Value = sScaleText6
  
    Dim oScaleProp7 As Inventor.Property
  oScaleProp7 = oCustomPropSet.Item("Scale7")
  If Err.number <> 0 Then
  oScaleProp7 = oCustomPropSet.Add("", "Scale7")
  End If
  oScaleProp7.Value = sScaleText7
  
    Dim oScaleProp8 As Inventor.Property
  oScaleProp8 = oCustomPropSet.Item("Scale8")
  If Err.number <> 0 Then
  oScaleProp8 = oCustomPropSet.Add("", "Scale8")
  End If
  oScaleProp8.Value = sScaleText8
  
    Dim oScaleProp9 As Inventor.Property
  oScaleProp9 = oCustomPropSet.Item("Scale9")
  If Err.number <> 0 Then
  oScaleProp9 = oCustomPropSet.Add("", "Scale9")
  End If
  oScaleProp9.Value = sScaleText9
  
    Dim oScaleProp10 As Inventor.Property
  oScaleProp10 = oCustomPropSet.Item("Scale10")
  If Err.number <> 0 Then
  oScaleProp10 = oCustomPropSet.Add("", "Scale10")
  End If
  oScaleProp10.Value = sScaleText10
  
 
  'Update the drawing.  This will update the title block scale
  oDrawingDoc.Update
 
End Sub

Once this part is fixed, I will be implementing this rule found here, replace a text box in the titlebock with iProperty. It will be a tad tricky as I will have to write it so that the drawing sheet number will grab the correct custom iProperty then insert it into the titleblock. ( drawingsheet:3 will grab iProp Scale3 etc....)

thanks!

[WCrihfield]

Hi @Shag_Bore.  Have you considered making that specific TextBox in your TitleBlockDefinition hold a 'Prompted Entry'.  If you did that, you would be able to manually fill in the value for that text within your TitleBlock on each sheet.  And, you can set the value for that Prompted Entry by code too.  It seems like it would be much easier to manage than what you are planning to do here.

[Shag_Bore]

Hey @WCrihfield 

I did consider it and actually found a previous post here.  I already have another rule that adds the sheet name to the title block and the prompted entry pop up dialogue box "triggers" me lol. It is a useless box that I press close on immediately as the field gets populated by the rule anyways. I was trying to avoid that with this scale rule, but worst case I implement it. 

I originally had this scale rule set up which works great on a single sheet .idw, I was just trying to work off it...

Thanks!

Public Sub Main()


  On Error Resume Next
  'Get the drawing document
  Dim oDrawingDoc As Inventor.DrawingDocument
  oDrawingDoc = ThisApplication.ActiveDocument
  'Dim oErrResponse As VbMsgBoxResult
  If Err.number <> 0 Then
    MsgBox("Active document must be a drawing", vbExclamation, "Error")
    Exit Sub
  End If
  
  'Get the first sheet
  Dim oSheet As Inventor.Sheet
  oSheet = oDrawingDoc.Sheets.Item(1)
  
  'Get the first view
  Dim oView As Inventor.DrawingView
  oView = oSheet.DrawingViews.Item(1)
  If Err.number <> 0 Then
    Resume Next
    Exit Sub
  End If
  
  'Get the view scale string
  Dim sViewScale As String
  sViewScale = oView.ScaleString
  
  'Get the custom propertyset
 Dim oCustomPropSet As Inventor.PropertySet
 oCustomPropSet = oDrawingDoc.PropertySets.Item("Inventor User Defined Properties")
  
  'Get the "Scale" custom iproperty.  If it doesn't exist, we'll create it
  Dim oScaleProp As Inventor.Property
  oScaleProp = oCustomPropSet.Item("Scale")
  If Err.number <> 0 Then
  oScaleProp = oCustomPropSet.Add("", "Scale")
  End If
  oScaleProp.Value = sViewScale
  
  'Update the drawing.  This will update the title block scale
  oDrawingDoc.Update
 
End Sub

[WCrihfield]

OK.  If you do not want to go the prompted entry route, then I will try to help you accomplish the task using the custom iPropoerties, as you started with here.  This code does mostly the same thing as your original, but just far more condensed, and easier to read through quickly.  It also does not include the notion of a pre-determined number of sheets or custom iProperties, it just uses the natural index number of the sheet as it goes, and creates (or updates) one custom iProperty per sheet (that has a view).  But be careful not to rearrange the sheets afterwards, because then you will have to use your second step again of changing out textbox contents in the TitleBlocks of every sheet again.

Sub Main
	If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then
		MsgBox("A Drawing document must be active for this code to work. Exiting.", vbCritical, "")
		Exit Sub
	End If
	Dim oDDoc As DrawingDocument = ThisDoc.Document
	Dim oSheets As Inventor.Sheets = oDDoc.Sheets
	Dim oCProps As Inventor.PropertySet = oDDoc.PropertySets.Item(4)
	For iSheetIndex As Integer = 1 To oSheets.Count
		Dim oSheet As Inventor.Sheet = oSheets.Item(iSheetIndex)
		If oSheet.DrawingViews.Count = 0 Then Continue For 'skip to next sheet
		Dim oView As DrawingView = oSheet.DrawingViews.Item(1)
		Dim sScale As String = oView.ScaleString
		Dim oCProp As Inventor.Property = Nothing
		Try
			oCProp = oCProps.Item("Scale" & iSheetIndex)
		Catch
			oCProp = oCProps.Add(sScale, "Scale" & iSheetIndex)
		End Try
		If oCProp.Value <> sScale Then oCProp.Value = sScale
	Next 'oSheet
	oDDoc.Update
End Sub

Maybe your drawing template could just start with 10+ sheets that are already set up this way, then if you don't need 10 sheets later, you can simply delete them.  This may not help existing drawings, but it may be a good time saver going forward.

If this solved your problem, or answered your question, please click ACCEPT SOLUTION .
Or, if this helped you, please click (LIKE or KUDOS) 👍.

[Shag_Bore]

Thanks! @WCrihfield 

This is hilarious, I had almost 300 lines written up and it wasn't even correct, your 23 lines seem to get me the desired custom iProperties with no issues haha...

Im going to now attempt to populate the titleblock with those iProperties...be back later probably

have a good one!