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
