Code:
Option ExplicitPublic Sub GetComponentReferencedByBalloon()
' Set a reference to the active drawing document
Dim oDoc As DrawingDocument
Set oDoc = ThisApplication.ActiveDocument
' Set Reference to Active Sheet on Drawing
Dim oSheet As Sheet
Set oSheet = oDoc.ActiveSheet
' Iterate through all the balloon in Sheet
Dim oBalloon As Balloon
For Each oBalloon In oSheet.Balloons
' Set Refrence to the Leader attached to the balloon
Dim leader As leader
Set leader = oBalloon.leader
'assuming the leader is a single line segment
Dim leaderNode As leaderNode
Set leaderNode = leader.AllNodes.Item(leader.AllNodes.count)
If Not leaderNode.AttachedEntity Is Nothing Then
' Set the intent of the leader
Dim intent As GeometryIntent
Set intent = leaderNode.AttachedEntity
' Set Reference to the curve that the leader points to
Dim curve As DrawingCurve
Set curve = intent.Geometry
' Set Reference to the geoetry that the curve belongs to
Dim oModelGeom As Object
Set oModelGeom = curve.ModelGeometry
' Get component occurance that the model geometry belongs to
Dim occurrence As ComponentOccurrence
Set occurrence = oModelGeom.ContainingOccurrence
' MsgBox "The part number is: " & occurrence.Name
' Iterate through all the balloon sets
Dim oBalloonValueSet As BalloonValueSet
For Each oBalloonValueSet In oBalloon.BalloonValueSets
'Dim strDisplay As String
' strDisplay = "Balloon Item Number: "
' Set Reference to the Quantity value of the component from the BOM
Dim oCount As Integer
oCount = oBalloonValueSet.ReferencedRow.BOMRow.ItemQuantity
' Set Reference to the Item Number on the BOM
Dim oBalloonNumber As Integer
oBalloonNumber = oBalloonValueSet.ItemNumber
' MsgBox "Balloon Number: " & oBalloonNumber & " - " & oCount
' If More than One Components, update Balloon with Item Number & Occurance Name
If oCount > 1 Then
'oBalloonValueSet.OverrideValue = oBalloonValueSet.Value & " - " & occurrence.Name
oBalloonValueSet.OverrideValue = occurrence.Name
Else
' Do Nothing
End If
Dim oDrawingBOMRow As DrawingBOMRow
Set oDrawingBOMRow = oBalloonValueSet.ReferencedRow
If oDrawingBOMRow.Custom Then
' The referenced item is a custom parts list row.
' strDisplay = strDisplay & vbNewLine & "Referenced Component(s):"
' strDisplay = strDisplay & vbNewLine & " Custom PartsList Row"
Else
Dim oBOMRow As BOMRow
Set oBOMRow = oDrawingBOMRow.BOMRow
' Add the Item Number from the model BOM.
' strDisplay = strDisplay & vbNewLine & "BOM Item Number: " & oBOMRow.ItemNumber
' strDisplay = strDisplay & vbNewLine & "Referenced Component(s):"
Dim oCompDefs As ComponentDefinitionsEnumerator
Set oCompDefs = oBOMRow.ComponentDefinitions
If oDrawingBOMRow.Virtual Then
' The referenced item is a virtual component.
' strDisplay = strDisplay & vbNewLine & " Virtual: " & oCompDefs.Item(1).DisplayName
Else
' Add the document name of the referenced component.
' There could be multiple if the balloon references
' a merged BOM row in the model.
Dim oCompDef As ComponentDefinition
' strDisplay = vbNewLine & strDisplay & vbNewLine & " " & oPartDef.Document.FullDocumentName
End If
End If
' MsgBox strDisplay
Next
End If
Next
End Sub
Foren auf CAD.de (alle Foren)
| 
.
