Highlight not ballooned Part/assembly of Model in Drawing

[jorge.pereira.01]

Hello,

Sometimes there are views on the drawing with a large number of rows in the Parts Lists. It makes difficult to identify all the balloon needed parts/Assemblies of the Model.

With some help of ilogic I already have a procedure which lists all the not ballooned rows, giving me their names. However, I would like to add some visual help like highlighting them on the drawing view.

Here is one example of the main goal, on the following image: 

In this example there is a not ballooned row on the Parts list. That row is clearly identified and their name is shown on a messagebox of an ilogic rule. The next intended step is to automatically highlight the row's referenced part/assembly on the view.

Is there any way of doing this? like accessing the model parts and make them selected or similar?

This could also be improved if we could click directly on a row/rows on the parts list, and their references became highlighted, but that is more of an idea for improvement of Inventor instead of customization via ilogic/vba.

Thank you

[SevInventor]

Hey,

found out how to do it with some help from here:

https://forums.autodesk.com/t5/inventor-ilogic-api-vba-forum/inventor-drawing-bom-or-parts-list-to-s...

https://forums.autodesk.com/t5/inventor-ilogic-api-vba-forum/add-occurrences-to-the-selection-in-dra...

The Code below works for me.

Now I would like to improve the code to highlight the remaining unballooned Occurrences while ballooning manually.

Maybe someone can help improving?

like or accept...

Sub Main()

	Dim oDoc As Document = ThisDoc.Document
    If oDoc.DocumentType <> kDrawingDocumentObject Then: MsgBox("Run in drawings only!"): Exit Sub: End If
        
	Dim oSheet As Sheet = oDoc.ActiveSheet
    If oSheet Is Nothing Then: MsgBox("Only valid for dwg files with sheets!"): Exit Sub: End If
	
    If oSheet.PartsLists.Count <> 1 Then: MsgBox("Only valid for sheets with 1 PartsList"):Exit Sub: End If
	Dim oPL As PartsList = oSheet.PartsLists(1)
	
    If oPL.PartsListRows.Count < 1 Then: MsgBox("Only valid for partslists with actual rows"): Exit Sub: End If
	If oSheet.Balloons.Count < 1 Then : MsgBox("Rule only valid for sheets with balloons!") : Exit Sub : End If
	Dim oAsmDoc As AssemblyDocument = ThisApplication.ActiveDocument.ReferencedDocuments.Item(1)	
	Dim oAsmDef As AssemblyComponentDefinition = oAsmDoc.ComponentDefinition
	Dim oview As DrawingView=oDoc.ActiveSheet.DrawingViews.item(2)	

	Dim oDoc1 As Document	
	Dim oSet As HighlightSet
	oSet = oDoc.CreateHighlightSet
   oview = ThisApplication.CommandManager _
        .Pick(kDrawingViewFilter, "Select a drawing view.")

	

	Dim Oocc As ComponentOccurrence
 		For Each oRow In oPL.PartsListRows
	 		If oRow.Ballooned = False Then

			oDoc1 = oRow.ReferencedFiles.Item(1).ReferencedDocument

					For Each Oocc In oAsmDef.Occurrences.AllReferencedOccurrences(oDoc1)
						Dim oCurveUnum As DrawingCurvesEnumerator
       					oCurveUnum = oview.DrawingCurves(Oocc)
        
        				Dim oCurve As DrawingCurve
        				Dim oSegment As DrawingCurveSegment
        
        					'add segments to collection to be moved to required layer
        				For Each oCurve In oCurveUnum
          					For Each oSegment In oCurve.Segments

						Try
							oSet.AddItem(oSegment)
							


Catch
	Continue For
End Try


					Next
					Next
					Next
			End If
		Next



Dim oColor As Color
oColor = ThisApplication.TransientObjects.CreateColor(0, 0, 255)

oSet.Color = oColor

MsgBox("ok?")

oSet.Clear()
End Sub 

[SevInventor]

Is it a solution?