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.
Subscribe