LINK BALLOON NUMBER TO A SHEET NUMBER

[SignelTrial]

Hello
i have this code that i am using which i want it to add the sheet number to a costume rule called PAGE where the balloon apears

Here’s the issue:
The rule runs without errors now, but it always returns "Not Ballooned" for every row — even for items that are clearly ballooned on the drawing.
Here’s the code

Sub Main()
Dim oDoc As DrawingDocument = Nothing
Try
oDoc = ThisApplication.ActiveEditDocument
Catch
MsgBox("This iLogic rule only works with drawing documents!")
Return
End Try

Dim oSheet As Sheet = oDoc.ActiveSheet
If oSheet.PartsLists.Count = 0 Then
MsgBox("No Parts List found on the active sheet!")
Exit Sub
End If

Dim oPL As PartsList = oSheet.PartsLists.Item(1)
Dim itemSheetMap As New Dictionary(Of String, String)

' Loop through each sheet
For Each sheet As Sheet In oDoc.Sheets
If Not sheet.Balloons Is Nothing Then
' Loop through each balloon on the sheet
For Each balloon As Balloon In sheet.Balloons
Try
If Not balloon.AttachedObjects Is Nothing And balloon.AttachedObjects.Count > 0 Then
' Loop through the attached objects
For Each attachedObj As Object In balloon.AttachedObjects
' Check if the attached object is a DrawingView
If TypeOf attachedObj Is DrawingView Then
Dim oDrawingView As DrawingView = attachedObj
If Not oDrawingView.ReferencedDocumentDescriptor Is Nothing Then
Dim balloonRefDocName As String = LCase(oDrawingView.ReferencedDocumentDescriptor.ReferencedFileDescriptor.FullFileName)

' Loop through each Parts List Row to find a match
For Each plRow As PartsListRow In oPL.PartsListRows
For Each plRefFile As File In plRow.ReferencedFiles
If LCase(plRefFile.FullFileName) = balloonRefDocName Then
' Found a match! Store the sheet name for this item number
Dim itemNumber As String = plRow.Item("ITEM").Value
If itemSheetMap.ContainsKey(itemNumber) Then
If Not itemSheetMap(itemNumber).Contains(sheet.Name) Then
itemSheetMap(itemNumber) = itemSheetMap(itemNumber) & ", " & sheet.Name
End If
Else
itemSheetMap.Add(itemNumber, sheet.Name)
End If
Exit For ' Exit parts list referenced files loop
End If
Next ' Next plRefFile
Next ' Next plRow
End If
End If
Next ' Next attachedObj
End If
Catch ' Catch any errors
End Try
Next ' Next balloon
End If
Next ' Next sheet

' Update the "Page" column in the Parts List
For Each row As PartsListRow In oPL.PartsListRows
Dim itemNumber As String = row.Item("ITEM").Value
If itemSheetMap.ContainsKey(itemNumber) Then
Try
row.Item("Page").Value = itemSheetMap(itemNumber)
Catch ex As Exception
MsgBox("Error setting value for column 'Page': " & ex.Message, vbExclamation)
End Try
Else
Try
row.Item("Page").Value = "Not Ballooned"
Catch ex As Exception
MsgBox("Error setting value for column 'Page': " & ex.Message, vbExclamation)
End Try
End If
Next ' Next row

MsgBox("Parts list updated with sheet numbers where balloons appear.")

End Sub

[SBix26]

Please try this in the Inventor Programming - iLogic, Macros, AddIns & Apprentice forum-- that's where you can expect to find the coding experts.

---

Sam B

Inventor Pro 2026 | Windows 11 Home 24H2