I'm generating single view part drawings for each part in an assembly and then adding labels to each view. The labels contain corresponding QTY, ITEM, and DESCRIPTION values from the partsList generated on the Assembly drawing. There seems to be an issue with the way I'm populating the arrays, and I am getting an "index is out or range" error. i.e., the number of labels generated is less than the number of drawing views. I can't for the life of me figure out why. Would really appreciate if someone could point out the issue.
Sub main()
Dim SelSet As SelectSet = ThisDrawing.Document.SelectSet
If SelSet.Count = 0 Then
MsgBox("You need to pre-select a drawing view before running this rule. Exiting.", , "")
Exit Sub
End If
Dim oView As DrawingView = SelSet.Item(1)
If oView Is Nothing Then Exit Sub
Dim oDrawDoc As DrawingDocument
oDrawDoc = ThisApplication.ActiveDocument
Dim OrgSheet As Sheet
OrgSheet = oDrawDoc.ActiveSheet
Dim oPartslist As PartsList = OrgSheet.PartsLists.Item(1)
oPartsList.Style = oDrawDoc.StylesManager.PartsListStyles.Item("ProwayTemp")
'get the view's model document
Dim oDoc As Document = oView.ReferencedDocumentDescriptor.ReferencedDocument
Dim oDrgDoc As DrawingDocument
oDrgDoc = ThisApplication.ActiveDocument
Dim PartDoc as Document
Dim initialX as Integer
Dim oSheet As Sheet
oSheet = oDrgDoc.Sheets.Add()
oSheet.Name = oDoc.DisplayName
Dim ItemList As New ArrayList
Dim QtyList As New ArrayList
Dim DescList As New ArrayList
initialX = 4
For Each PartDoc in oDoc.AllReferencedDocuments
If PartDoc.DocumentType = kPartDocumentObject Then
Call CreateDrawing(PartDoc, initialX, oSheet)
initialX = initialX + 10
no_of_part_docs += 1
'get iproperty to compare with partslist
oPartProp = PartDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
For Each oRow As PartsListRow In oPartslist.PartsListRows
oPartValue = oRow.Item("PART NUMBER").Value
If oPartValue = oPartProp Then
Dim itemValue As String = oRow.Item("ITEM").Value
Dim qtyValue As String = oRow.Item("QTY").Value
Dim descValue As String = oRow.Item("DESCRIPTION").Value
ItemList.Add(itemValue)
QtyList.Add(qtyValue)
DescList.Add(descValue)
End If
Next
End If
Next
oPartsList.Style = oDrawDoc.StylesManager.PartsListStyles.Item("Proway")
Dim descListString As String
descListString = "ItemList contents:" & vbCrLf
' Iterate through each item in the DescList
For Each descValue As String In DescList
descListString = descListString & descValue & vbCrLf
Next
' Display the itemListString in a message box
MsgBox(descListString)
If no_of_part_docs = 0
MsgBox("Please select an assembly to run this function.")
End If
'ArrangeViews(oSheet, PartDoc)
'iLogicVb.RunExternalRule("ArrangeViews_StNo")
iLogicVb.RunExternalRule("DimMasterRuleFinal")
Dim _view As DrawingView
'Add Properties in the Label
oSheet.Activate()
Dim ItemIndex As Integer
ItemIndex = 0
For Each view In oSheet.DrawingViews
_view = view
_view.ShowLabel = True
oDocName = _view.ReferencedDocumentDescriptor.ReferencedDocument.DisplayName
'MsgBox(oDocName)
If _view IsNot Nothing Then
'get the properties from the model
'oDescription = iProperties.Value(oDocName, "Project", "Description")
'modify the view label as needed
_view.Label.FormattedText = "ITEM " & ItemList(ItemIndex) & vbCrLf & DescList(ItemIndex) & vbCrLf & QtyList(ItemIndex) & " REQUIRED"
Dim PT1 As Point2d
PT10 = ThisApplication.TransientGeometry.CreatePoint2d
PT10.X = _view.Center.X
PT10.Y = _view.Top - _view.Height - 1
_view.Label.Position = PT10
End If
ItemIndex += 1
Next
End Sub
Sub CreateDrawing(oDoc As PartDocument, initialX As Integer, oSheet As Sheet)
'------ Locating the Template ------'
'strLocation = ThisApplication.FileOptions.TemplatesPath
'oDrgDoc = ThisApplication.Documents.Add(kDrawingDocumentObject, strLocation & "CPT-DRAWING-TEMPLATE.idw")
Dim oDrgDoc As DrawingDocument
oDrgDoc = ThisApplication.ActiveDocument
'Set the sheet size
ActiveSheet.ChangeSize("A3", moveBorderItems := True)
'Add / Change the drawing border
ActiveSheet.Border = "Default Border"
ActiveSheet.SetTitleBlock("PW")
' Get the TransientBRep and TransientGeometry objects.
Dim transBRep As TransientBRep = ThisApplication.TransientBRep
Dim transGeom As TransientGeometry = ThisApplication.TransientGeometry
' Combine all bodies in Part into a single transient Surface Body.
Dim combinedBodies As SurfaceBody = Nothing
For Each surfBody As SurfaceBody In oDoc.ComponentDefinition.SurfaceBodies
If combinedBodies Is Nothing Then
combinedBodies = transBRep.Copy(surfBody)
Else
transBRep.DoBoolean(combinedBodies, surfBody, BooleanTypeEnum.kBooleanTypeUnion)
End If
Next
' Get the oriented mininum range box of all bodies in Part.
' NOTE: "OrientedMinimumRangeBox" was added in Inventor 2020.3/2021.
Dim minBox As OrientedBox = combinedBodies.OrientedMinimumRangeBox
' Get length of each side of mininum range box.
Dim dir1 As Double = minBox.DirectionOne.Length
Dim dir2 As Double = minBox.DirectionTwo.Length
Dim dir3 As Double = minBox.DirectionThree.Length
' Convert lengths to document's length units.
Dim uom As UnitsOfMeasure = oDoc.UnitsOfMeasure
dir1 = uom.ConvertUnits(dir1, "cm", uom.LengthUnits)
dir2 = uom.ConvertUnits(dir2, "cm", uom.LengthUnits)
dir3 = uom.ConvertUnits(dir3, "cm", uom.LengthUnits)
' Sort lengths from smallest to largest.
Dim lengths As New List(Of Double) From {dir1, dir2, dir3}
lengths.Sort
Dim minLength As Double = lengths(0)
Dim midLength As Double = lengths(1)
Dim maxLength As Double = lengths(2)
Dim desiredWidthOnSheet As Double
Dim desiredHeightOnSheet As Double
desiredWidthOnSheet = (oSheet.Width / 2) + 10 ' Adjust as needed
desiredHeightOnSheet = (oSheet.Height / 2) + 10 ' Adjust as needed
' Calculate the scale factor based on the part dimensions and desired size on the sheet
Dim scaleFactor As Double
scaleFactor = Min(desiredWidthOnSheet*5 / partWidth, desiredHeightOnSheet*5 / maxLength)
Dim offset as Integer
offset = 3
'Location of the Views
Dim oPoint2 As Point2d
oPoint2 = ThisApplication.TransientGeometry.CreatePoint2d(initialX, (oSheet.Height/1.5) + offset)
Dim oView1 As DrawingView
oView1 = oSheet.DrawingViews.AddBaseView(oDoc, oPoint2, (scaleFactor), kLeftViewOrientation, kHiddenLineDrawingViewStyle)
End Sub
I didn't have time to check but I would check if your array indexes actually produce meaningfully values on this line here. Use a message box or logger line and make sure you don't exceed the array count. You can perhaps put a try catch statement around any problem areas and narrow down the line.
_view.Label.FormattedText = "ITEM " & ItemList(ItemIndex) & vbCrLf & DescList(ItemIndex) & vbCrLf & QtyList(ItemIndex) & " REQUIRED
Thanks for you reply. My code works perfectly for all assemblies except those containing subassemblies. Though it creates drawing views of all the parts, it does not create labels for all of them. Do you know how I can treat the subassembly parts differently so that labels are created for its parts too?
Your not getting labels for sub assemblies because your looping through top level assemblies only in the partlist.
For Each oRow As PartsListRow In oPartslist.PartsListRows
oPartValue = oRow.Item("PART NUMBER").Value
You need to check the row referenced doc is an assembly and then expand that assembly row to expose the children beneath. Equivalent of pressing the plus sign in the partlist manually.
Syntax
PartsListRow.ReferencedRows() As ObjectsEnumerator
See full method to expose document reference of partlist row here.
Syntax
PartsListRow.Expanded() As Boolean
Can't find what you're looking for? Ask the community or share your knowledge.