Balloon all occurrences in view

[A.Acheson]

Hi All,

Happy holidays and hope everyone is doing well and is keeping warm and hydrated. While people are chewing on some turkey or food of choice hopefully someone can offer assistance to this post.  

I was doing a little learning last week with a great piece of code posted  kindly by @ j.haggenjos

Link Here. I was able to balloon parts that have been rolled up via the part number where they have separate document descriptors. However I was not able to balloon multiple occurrences. Shown in the partslist  as missing 006 balloons

These are the changes to Subs so far that gets a portion of the way there. What else needs to be changed?  Attached is the text file with these changes. Any help much appreciated.

Friend Sub AddBallonToView(View As DrawingView)
		Dim PartsList As PartsList = View.Parent.PartsLists.Item(1)
        InitialiseViewBoundingBox(View)
        For Each Row As PartsListRow In PartsList.PartsListRows
			For RefQty = 1 To Row.ReferencedFiles.Count 'Run for all references files
				CreateRowItemBalloon(Row, View)
	        Next
		 Next
        ArrangeBalloonsOnView(View) 
    End Sub
	Public RefQty As Integer

and

Private Function GetBalloonAttachGeometry(Item As PartsListRow, View As DrawingView) As GeometryIntent
		Dim itemOccurrences As ComponentOccurrencesEnumerator = View.ReferencedDocumentDescriptor.ReferencedDocument.ComponentDefinition.Occurrences.AllReferencedOccurrences(Item.ReferencedFiles.Item(RefQty).DocumentDescriptor)
        Dim OccurrencesCurves As List(Of DrawingCurve) = GetCurvesFromOcc(itemOccurrences, View)
        Return GetAttachPoint(GetBestSegmentFromOccurrence(OccurrencesCurves))
    End Function

[Michael.Navara · Accepted solution]

This is my modification of your code to create balloons to all occurrences in the view. Full code is in attachment, here is just a modifications. I need to create two new functions and modify one

Modified method AddBallonToView:

Friend Sub AddBallonToView(View As DrawingView)
    Dim PartsList As PartsList = View.Parent.PartsLists.Item(1)
    InitialiseViewBoundingBox(View)
    For Each Row As PartsListRow In PartsList.PartsListRows
        For RefQty = 1 To Row.ReferencedFiles.Count 'Run for all references files
            'CreateRowItemBalloon(Row, View)
            CreateRowItemBalloonMultiple(Row, View)
        Next
    Next
    ArrangeBalloonsOnView(View)
End Sub

New method which replace the CreateRowItemBalloon

Private Sub CreateRowItemBalloonMultiple(partsListRow As PartsListRow, view As DrawingView)
    Dim TransGeom As TransientGeometry = ThisApplication.TransientGeometry
    Dim attachPoints As GeometryIntent() = GetBalloonAttachGeometryMultiple(partsListRow, view)
    If attachPoints Is Nothing Then Exit Sub
    If attachPoints.Length = 0 Then Exit Sub

    For Each attachPoint As GeometryIntent In attachPoints
        Dim leaderPoint As Point2d = GetBalloonPosition(attachPoint.PointOnSheet, view)
        Dim LeaderPoints As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
        LeaderPoints.Add(leaderPoint)
        LeaderPoints.Add(attachPoint)
        view.Parent.Balloons.Add(LeaderPoints)
    Next
End Sub

New method which replace the GetBalloonAttachGeometry

Private Function GetBalloonAttachGeometryMultiple(partsListRow As PartsListRow, view As DrawingView) As GeometryIntent()
    Dim attachPoints As New List(Of GeometryIntent)

    Dim referencedAssy = TryCast(view.ReferencedDocumentDescriptor.ReferencedDocument, AssemblyDocument)
    If referencedAssy Is Nothing Then Return attachPoints.ToArray()

    For Each referencedFileDescriptor As ReferencedFileDescriptor In partsListRow.ReferencedFiles
        Dim documentDescriptor As DocumentDescriptor = referencedFileDescriptor.DocumentDescriptor
        Dim rowOccurrences As ComponentOccurrencesEnumerator = referencedAssy.ComponentDefinition.Occurrences.AllReferencedOccurrences(documentDescriptor)
        For Each rowOccurrence As ComponentOccurrence In rowOccurrences

            'Dim occurrencesCurves As List(Of DrawingCurve) = GetCurvesFromOcc(rowOccurrence, view)
            Dim occurrenceDrawingCurvesEnumerator As DrawingCurvesEnumerator = view.DrawingCurves(rowOccurrence)
            Dim occurrencesCurves As List(Of DrawingCurve) = occurrenceDrawingCurvesEnumerator.OfType(Of DrawingCurve).ToList()

            Dim attachPoint As GeometryIntent = GetAttachPoint(GetBestSegmentFromOccurrence(occurrencesCurves))
            attachPoints.Add(attachPoint)

        Next
    Next
    Return attachPoints.ToArray()

End Function

[A.Acheson · Accepted solution]

Thanks for the response and work you put in Michael much appreciated. It does indeed work after making one change of adding  this line in the for loop of CreateRowItemBalloonMultiple Sub Routine.

	If attachPoint Is Nothing Then Continue For

As to what changes you did I am still trying to figure that out. Has it got to do with attachment points per occurrence? I thought they were running on each occurrence on the original as I could get multiple Occurrences by name but clearly they were not.