Balloon Renumbering Across Sheets

I recently received a challenge from an Autodesk dealer that I couldn’t let sit since it seemed like it shouldn’t be too hard to solve. The problem he’s trying to solve is the case where the first sheet of a drawing contains a full assembly which is ballooned.  Other sheets in the drawing contains subassemblies and parts that are used in the full assembly.  What he wants is that the balloon numbers on the later sheets all match the numbers on the first sheet.  By default, each document gets its own set of part numbers so each subassembly will begin numbering it parts at 1.

The following VBA code is my attempt at a solution.  I didn’t put it through a lot of testing but it worked on what I did throw at it.  To use it, just have a drawing open and run the macro.  It can be re-run at any point to update the balloons is balloons on the first sheet are added or renumbered.

The program assumes the full assembly is on the first sheet and it examines all of the balloons on the first sheet getting the number and the document associated with the part the balloon is pointing at.  The program also determines the highest number used by any of the balloons on the first sheet.  The program then looks through the other sheets, examining each balloon to see if it points to any of same parts that were ballooned in the full assembly.  If it is a part already ballooned, the program overrides the balloon number using the number from the full assembly.  If the part or subassembly isn’t represented in the large assembly, it assigns it the next highest number.

' User-defined type used in the code code below.
Private Type udtPartInfo
   Number As Integer
   ReferencedFile As String
End Type


Public Sub RenumberBalloonsToFirstSheet()
   ' Get the active drawing document.
   If ThisApplication.ActiveDocumentType <> _
                                         kDrawingDocumentObject Then
      MsgBox "A drawing must be active."
      Exit Sub
   End If
 
   Dim drawDoc As DrawingDocument
   Set drawDoc = ThisApplication.ActiveDocument
   
   ' Get the first sheet
   Dim baseSheet As Sheet
   Set baseSheet = drawDoc.Sheets.Item(1)
   
   ' Get the drawing BOM from a balloon.  An assumption is that
   ' there is only one assembly represented on the sheet since
   ' this is arbitrarily using the BOM data of assembly associated
   ' with the first balloon found.
   Dim valSet As BalloonValueSet
   Set valSet = baseSheet.Balloons.Item(1).BalloonValueSets.Item(1)
   Dim drawBOM As DrawingBOM
   Set drawBOM = valSet.ReferencedRow.Parent
   Dim partInfo() As udtPartInfo
   ReDim partInfo(drawBOM.DrawingBOMRows.Count - 1)
  
   ' Determine which column contains the item number information.
   Dim itemColumn As Integer
   Dim i As Integer
   For i = 1 To drawBOM.DrawingBOMColumns.Count
      If drawBOM.DrawingBOMColumns.Item(i).PropertyType = _
                                        kItemPartsListProperty Then
         itemColumn = i
         Exit For
      End If
   Next
  
   For i = 1 To drawBOM.DrawingBOMRows.Count
      Dim drawBOMRow As DrawingBOMRow
      Set drawBOMRow = drawBOM.DrawingBOMRows.Item(i)

      ' Get the filename of the file associated with this
      ' row of the BOM.
      Dim partDef As PartComponentDefinition
      Set partDef = drawBOMRow.BOMRow.ComponentDefinitions.Item(1)
      partInfo(i - 1).ReferencedFile = partDef.Document.FullFileName
     
      ' Get the part number from the drawing BOM.  This could
      ' be different than the assembly BOM since it can be
      ' overridden in the drawing.
      partInfo(i - 1).Number = drawBOMRow.Item(itemColumn).Value
   Next
   
   ' Iterate through the other sheets setting the balloon values
   ' to match these. If a balloon to a new part is found it will
   ' be set to the next highest value so all parts have unique
   ' balloon values.
   For i = 2 To drawDoc.Sheets.Count
      Dim currentSheet As Sheet
      Set currentSheet = drawDoc.Sheets.Item(i)

      ' Look through the balloons on this sheet.
      Dim checkBalloon As Balloon
      For Each checkBalloon In currentSheet.Balloons
         ' Initialize the flag indicating a match was found.
         Dim matchFound As Boolean
         matchFound = False
         Dim valueSet As BalloonValueSet
         Set valueSet = checkBalloon.BalloonValueSets.Item(1)
         Dim checkFilename As String
         checkFilename = _
                      valueSet.ReferencedFiles.Item(1).FullFileName 

         ' Find the data that matches this balloon.
         Dim j As Integer
         For j = 0 To UBound(partInfo)
            If checkFilename = partInfo(j).ReferencedFile Then
               ' Override the balloon value to match, if
               ' it's different.
               matchFound = True
               If valueSet.ItemNumber <> partInfo(j).Number Then
                  valueSet.OverrideValue = partInfo(j).Number
               End If
               Exit For
            End If
         Next
      Next
   Next
End Sub

 

Updates:
Feb. 22, 2011: Revised the code because of some problems pointed out in the previous version.  The previous version was dependent on a balloon being present on the first sheet for every part in the assembly, which is not realistic.  The new code relies on the BOM, which will include every part.

Comments

[stianj]

Any way to convert this to VB.net, so I can use it as an iLogic rule?

[Nate]

I achieve nearly the same thing without any VBA code: create a custom BOM column (e.g. "ITEM NO.") in the top-level assembly's BOM. Then edit the balloon style to display "ITEM NO." rather than "ITEM". Add the "ITEM NO." column to the Parts List style (overwrite the column header to read "ITEM" if you wish). In the top-level assembly's BOM, copy the "Item" column and paste it into the "ITEM NO." column. Now the balloons display a custom iProperty associated with each part, rather than Inventor's assigned item number within each assembly. So, no matter where the assembly or sub-assembly lies in the drawing, the balloon always shows the same number.

[Reg Hasell]

Hi Brian
Brilliant code, I use it a lot, thank you.

One issue: If the Sub Assemblies are on the same page (Page 1), the balloons do not update, I have to place the views on Page 2, run the code, then copy the views back to page 1.

What changes can be made to the code to allow the ballons to update on page 1 as well?

[Stian]

When I place a balloon for the assembly (one is enough), this works great! But if a balloon isn't placed at all, I get an error. The follow line is being highlighted:

Set valSet = baseSheet.Balloons.Item(1).BalloonValueSets.Item(1)

Any way to fix this, or tell the user an error message saying a balloon must be placed?

[Wojciech]

Hi Brain,

I have a problem.

"If valueSet.ItemNumber <> partInfo(j).Number Then"

The both parts see each other but the program stops there and is yellow highlight and doesn't do anything. what is it wrong maybe I am doing something wrong..

Cheers

Wojtek