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

Hi,

Thanks for providing your code which profoundly inspired me to overcome some obstacles. However, I developed my own code. This is the most sophisticated code I have written

Public GOccName As String

Sub main()

Call AddBalloon("E", "W04_Outer", 2, 2, 0.5)
'Call AddBalloon("E", "BlowPipe_01", -1, -1, 0.5)
 
' This does not work because it is a pipe projected in the drawing (Balloon 'item No.28) as shown in the figure in the post

End Sub


Sub AddBalloon(viewName As String, AttributeName As String, x As Double, y As Double, intent As Double)

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

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

'Reference the View we want
Dim sViewName As String
    sViewName = viewName

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

If oView Is Nothing Then
    Call MsgBox("View named " & sViewName & " was not found. Exiting.", vbCritical, "Drawing View")
    Exit Sub
    ElseIf oView.Suppressed = True Then
    oView.Suppressed = False
    Exit Sub
End If
    
'Reference the Model on that Sheet
Dim oAssemblyDoc As Document
Set oAssemblyDoc = oView.ReferencedDocumentDescriptor.ReferencedDocument

'Find the assigned Attribute on 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)

If oObjs.Count = 0 Then
    Call MsgBox("attribute name " & sAttributeName & _
    " was not found. Exiting.", vbCritical, "Attribute object")
    Exit Sub
End If

' get the 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")
    Exit Sub
End If

GOccName = oOccName

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

If Oocc Is Nothing Then
    Call MsgBox("the Occurrence of the detected object is Not found. Exiting", vbCritical, "Occurrence")
    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


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

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)
            Exit For
        End If
    End If
Next

If oViewCurves Is Nothing Then
    Call MsgBox("Occurrence does not belong to the view. Exiting", vbExclamation, "View Refrence Documents")
    Exit Sub
End If

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

Dim ocurve As DrawingCurve
Set ocurve = oViewCurves.Item(1)

' locate a text point for the Balloon 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 + x
Ypos = oMidPoint.y + y

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)

' 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

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
            'MsgBox "ATTWNTION"
            Set OccSearch = OccSearch(SubCompOcc.Definition.Document)
    
            If Not OccSearch Is Nothing Then
                Exit Function
            End If
    End If
    
Next
Set OccSearch = Nothing
End Function

so far that I wanted to share with you to even develop it further. Thanks to @WCrihfield