Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.

This is the Code to add a balloon using VBA with the Attribute helper.

Sub AddBalloon(SheetNo As Double, viewName As String, AttributeName As String _
                , xPosition As Double, yPosition As Double, intent As Double)

' 1- Reference the drwing file A8-003 that must be open specifically
If ThisApplication.ActiveDocument.DocumentType <> _
   DocumentTypeEnum.kDrawingDocumentObject Then
   Call MsgBox("The drawing document is Not active." _
   & " Please Activate it first", vbOKOnly, "Document Type")
   BCheck = False
   Exit Sub
Else
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
End If

' 2- Reference the active Sheet
If oDrawDoc.DisplayName <> "1Fxxx-A8-0x.dwg" Then
    Call MsgBox(" You need to open A8-003 Drawing", vbCritical, "Drawing file")
    BCheck = False
   Exit Sub
Else
    Dim oSheet As Sheet
    Set oSheet = oDrawDoc.Sheets.Item(SheetNo)
End If

' 3- Reference the needed drwing View

Dim oView As DrawingView

For i = 1 To oSheet.DrawingViews.Count
    If oSheet.DrawingViews.Item(i).Name = viewName Then
        Set oView = oSheet.DrawingViews.Item(i)
    End If
Next

'Verify that the selected drawing view exist, and not suppressed.
If oView Is Nothing Then
    Call MsgBox("View named (" & viewName & ") was not found. Exiting.", vbCritical, "Drawing View")
    BCheck = False
    Exit Sub
ElseIf oView.Suppressed = True Then
    oView.Suppressed = False
    BCheck = False
    Exit Sub
End If
    
' 4- Reference the Model on that Sheet
Dim oAssemblyDoc As Document
Set oAssemblyDoc = oView.ReferencedDocumentDescriptor.ReferencedDocument

'Verify that the selected drawing view is of an assembly.
If oAssemblyDoc.DocumentType <> kAssemblyDocumentObject Then
    Call MsgBox("The selected View must be of an assembly", vbInformation, "Document Type")
    BCheck = False
    Exit Sub
End If
 
' 5- Find the assigned Attribute of an Object
Dim sAttributeSetName As String
Dim sAttributeName As String

sAttributeSetName = "Balloon"
sAttributeName = AttributeName

Dim oObjs As ObjectCollection
Set oObjs = oAssemblyDoc.AttributeManager _
.FindObjects(sAttributeSetName, sAttributeName)

' Verify the existance of the assigned attribute
If oObjs.Count = 0 Then
    Call MsgBox("attribute name " & sAttributeName & _
    " was not found. Exiting.", vbCritical, "Attribute object")
   BCheck = False
   Exit Sub
End If

' 6- get the needed face of the object
Dim oTypeName As String
    oTypeName = TypeName(oObjs.Item(1))

Dim oFace As Face
Dim oFaceProxy As FaceProxy
Dim oOccName As String

If oTypeName = "Face" Then
    Set oFace = oObjs.Item(1)
    oOccName = oFace.ContainingOccurrence.Name
    
ElseIf oTypeName = "FaceProxy" Then
    Set oFaceProxy = oObjs.Item(1)
    oOccName = oFaceProxy.ContainingOccurrence.Name
    
Else
    Call MsgBox("the assigned object's Face was Not found. Exiting", vbCritical, "Face")
    BCheck = False
    Exit Sub
End If

GOccName = oOccName

' 7- get the occurrence of the detected object's face
Dim Oocc As ComponentOccurrence
Set Oocc = OccSearch(oAssemblyDoc)

' Verify the existance of the assigned occurrence
If Oocc Is Nothing Then
    Call MsgBox("the Occurrence of the detected object is Not found. Exiting", vbCritical, "Occurrence")
    BCheck = False
    Exit Sub
End If

Dim oParentOcc As ComponentOccurrence
Set oParentOcc = Oocc.ParentOccurrence

If oTypeName = "Face" Then
    Call Oocc.CreateGeometryProxy(oFace, oFaceProxy)
    
    If Not oParentOcc Is Nothing Then
        Call oParentOcc.CreateGeometryProxy(oFace, oFaceProxy)
    End If
End If


' 8- Promote to an DrawingCurve on the View
Dim oViewAllCurves As DrawingCurvesEnumerator
Dim oViewCurves As DrawingCurvesEnumerator
Dim ocurve As DrawingCurve

Set oViewAllCurves = oView.DrawingCurves

For i = 1 To oViewAllCurves.Count

    If oViewAllCurves.Item(i).StartPoint Is Nothing Or _
        oViewAllCurves.Item(i).Evaluator3D Is Nothing Or _
        oViewAllCurves.Item(i).ModelGeometry Is Nothing Then
        i = i + 1
    Else
        If oViewAllCurves.Item(i).ModelGeometry.ContainingOccurrence.Name = oOccName Then
            Set oViewCurves = oView.DrawingCurves(oFaceProxy)
            If oViewCurves.Count <> 0 Then
               Set ocurve = oViewCurves.Item(1)
               Exit For
            Else
                Set ocurve = oViewAllCurves.Item(i)
                Exit For
            End If
        End If
    End If
Next

' Verify the existance of the assigned Curve
If ocurve Is Nothing Then
    Call MsgBox("Occurrence does not belong to the view. Exiting", vbExclamation, "View Refrence Documents")
    BCheck = False
    Exit Sub
End If

If oViewAllCurves.Count = 0 Then
    Call MsgBox("No curves found in view. Exiting", vbExclamation, "Drawing Curves")
    BCheck = False
    Exit Sub
End If


' 9- locate a position for the text point of the Balloon
' this will be relative to the assigned curve
Dim oMidPoint As Point2d
Set oMidPoint = ocurve.MidPoint

Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry

Dim Xpos As Double
Dim Ypos As Double

Xpos = oMidPoint.x + xPosition
Ypos = oMidPoint.y + yPosition

Set oPoint = oTG.CreatePoint2d(Xpos, Ypos)

' Attach Balloon to the text point
Dim oLeaderPoint As ObjectCollection
Set oLeaderPoint = ThisApplication.TransientObjects _
.CreateObjectCollection

Call oLeaderPoint.Add(oPoint)

' 10- locate a leader point for the Balloon

Dim GI As GeometryIntent
Set GI = oSheet.CreateGeometryIntent(ocurve, intent)

Call oLeaderPoint.Add(GI)

' Deleting the dublicated Balloon if any
Dim K As Integer
    K = oSheet.Balloons.Count ' Number of Balloons

Dim counter As Integer
    counter = 0 ' Number of similar balloons

For i = 1 To K
    While i < K
        If oSheet.Balloons.Item(i).ParentView.Name = sViewName Then
            If oSheet.Balloons.Item(i).Position.x = Xpos And _
               oSheet.Balloons.Item(i).Position.y = Ypos Then
               oSheet.Balloons.Item(i).Delete
               K = K - 1
            End If
        End If
      i = i + 1
    Wend
Next

' Adding the Balloon
Dim oBalloon As Balloon
Set oBalloon = oSheet.Balloons.Add(oLeaderPoint)

' Deleting previously exsited balloon if any
Dim oBalloonItemNumber As String
    oBalloonItemNumber = oBalloon.BalloonValueSets _
    .Item(1).ItemNumber
    
K = oSheet.Balloons.Count ' Updated Number of Balloons

For i = 1 To K
    While i < K
        If oSheet.Balloons.Item(i).ParentView.Name = sViewName _
        And oSheet.Balloons.Item(i).BalloonValueSets _
            .Item(1).ItemNumber = oBalloonItemNumber _
            And oSheet.Balloons.Item(i).Position.x <> Xpos And _
                oSheet.Balloons.Item(i).Position.y <> Ypos Then
                counter = counter + 1
                
            If counter >= 1 Then
                oSheet.Balloons.Item(i).Delete
                K = K - 1
                i = i - 1
            End If
            
        End If
        
      i = i + 1
    Wend
Next

   BCheck = True
   
End Sub

Function OccSearch(AssemblyDoc As AssemblyDocument) As ComponentOccurrence

Dim CompName As String

For Each SubCompOcc In AssemblyDoc.ComponentDefinition.Occurrences
     CompName = SubCompOcc.Name
    If CompName = GOccName Then
        Set OccSearch = SubCompOcc
         Exit Function
    End If
        
    If SubCompOcc.Visible = True And _
        SubCompOcc.Suppressed = False And _
        SubCompOcc.BOMStructure = kNormalBOMStructure And _
        SubCompOcc.DefinitionDocumentType = kAssemblyDocumentObject Then
            Set OccSearch = OccSearch(SubCompOcc.Definition.Document)

            If Not OccSearch Is Nothing Then
                Exit Function
            End If
    End If
    
Next
Set OccSearch = Nothing
End Function

I hope everyone finds it useful.

Thanks