Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
SevInventor
in reply to: mat_hijs

with this code you can step through each Partlist row and have the Occurrences marked blue.

Maybe it helps you a bit.

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
	 		

			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
		Dim oColor As Color
oColor = ThisApplication.TransientObjects.CreateColor(0, 0, 255)

oSet.Color = oColor

MsgBox("ok?")

oSet.Clear()	
		Next




End Sub