Connecting Sketchedsymbol to Balloon using VB

[subrahmanyam.srinivas]

Hi,

I am trying to create & connect a Sketchedsymbol to a balloon. I was able to create the sketched symbol but, i was not able to connect to balloon. 

  The code is as below

Public Sub AddBalloonAnnotation()

Dim oGetPoint As New clsGetPoint ' custom class object
Dim oClick As Point2d
Dim DrawDoc As DrawingDocument
Dim oActiveSheet As Sheet
Dim odrawview As DrawingView
Dim oSketchedSymbolDef As SketchedSymbolDefinition
Dim oSketchedSymbol As SketchedSymbol
Dim OTG As TransientGeometry
Dim oBalloon As Balloon
Dim n As Integer
Dim result As String
Dim pntBalloonSets() As Variant
Dim pntBalloon() As Variant

Dim intClosestDistance As Double
Dim intClosestBalloonSet As Integer
Dim intClosestBalloon As Integer
Dim pntClosestBalloon As Point2d
Dim XX As String

Dim i, j As Integer
Dim dblVOffset As Double
Dim dblHOffset As Double
Dim dist As Double
Dim tempPos As Point2d
Dim oLeaderPoints As ObjectCollection

Dim oSelect As New clsSelect
Dim oMidPoint As Point2d
Dim ResultText As String

Dim oDrawingCurve As Balloon 'DrawingCurve
Dim oGeometryIntent As GeometryIntent

Dim oAngle As Double
Dim oSketchSymDef As SketchedSymbolDefinition
Dim sPromptStrings(1) As String

If ThisApplication.Documents.Count = 0 Then
MsgBox "You must have a drawing document open to use this tool.", vbCritical
Exit Sub
End If

If ThisApplication.ActiveDocumentType <> kDrawingDocumentObject Then
MsgBox "This tool is only applicable to drawing documents.", vbCritical
Exit Sub
End If

' Create a new clsSelect object.

Set DrawDoc = ThisApplication.ActiveDocument
Set oActiveSheet = DrawDoc.ActiveSheet
Set OTG = ThisApplication.TransientGeometry

'Pick a point where u want to place symbol
MsgBox "Pick the point where you want to place the Symbol", vbInformation + vbOKOnly
Set oClick = oGetPoint.GetPoint(oActiveSheet, "Pick the point where you want to place the Symbol")

If oClick Is Nothing Then
Exit Sub
End If


' now loop through all the balloons on the drawing and find the one closest to the user's click
For Each oBalloon In oActiveSheet.Balloons

Set odrawview = oBalloon.ParentView
i = i + 1
Select Case oBalloon.PlacementDirection

Case kBottomDirection
dblVOffset = -1 * in2cm(2 * sngBalloonRad)
dblHOffset = 0
Case kTopDirection
dblVOffset = in2cm(2 * sngBalloonRad)
dblHOffset = 0
Case kRightDirection
dblVOffset = 0
dblHOffset = in2cm(2 * sngBalloonRad)
Case kLeftDirection
dblVOffset = 0
dblHOffset = -1 * in2cm(2 * sngBalloonRad)

End Select
Set tempPos = oBalloon.Position
For j = 0 To oBalloon.BalloonValueSets.Count - 1
tempPos.X = oBalloon.Position.X + j * dblHOffset
tempPos.y = oBalloon.Position.y + j * dblVOffset
dist = tempPos.DistanceTo(oClick)
If (dist < intClosestDistance Or intClosestDistance = 0) Then
intClosestDistance = dist
intClosestBalloonSet = i
intClosestBalloon = j + 1
Set pntClosestBalloon = OTG.CreatePoint2d(tempPos.X, tempPos.y)
End If
Next j
Next

If intClosestBalloonSet = 0 Then
Exit Sub
End If

Set oMidPoint = pntClosestBalloon
'Set a reference to the TransientGeometry object.
Set OTG = ThisApplication.TransientGeometry
Set oLeaderPoints = ThisApplication.TransientObjects.CreateObjectCollection
Set oDrawingCurve = ThisApplication.CommandManager.Pick(kDrawingBalloonFilter, "SELECT Ballo000n")
Set oGeometryIntent = oActiveSheet.CreateGeometryIntent(oDrawingCurve, kCircularRightPointIntent)
Debug.Print oGeometryIntent.Type
Debug.Print oDrawingCurve.Style.BalloonDiameter
Debug.Print oDrawingCurve.BalloonValueSets(1).Value

'Call oLeaderPoints.Add(oGeometryIntent)
oAngle = Math.Atn(oClick.y - oDrawingCurve.Position.y) / (oClick.X - oDrawingCurve.Position.X)

If (oClick.X - oDrawingCurve.Position.X) < 0 And oAngle < 10 Then
Call oLeaderPoints.Add(OTG.CreatePoint2d(oClick.X, oDrawingCurve.Position.y))
Call oLeaderPoints.Add(OTG.CreatePoint2d(oDrawingCurve.Position.X - (oDrawingCurve.Style.BalloonDiameter / 2), oDrawingCurve.Position.y))
End If

If (oClick.X - oDrawingCurve.Position.X) > 0 And oAngle < 10 Then
Call oLeaderPoints.Add(OTG.CreatePoint2d(oClick.X, oDrawingCurve.Position.y))
Call oLeaderPoints.Add(OTG.CreatePoint2d(oDrawingCurve.Position.X + (oDrawingCurve.Style.BalloonDiameter / 2), oDrawingCurve.Position.y))
End If

If (oClick.y - oDrawingCurve.Position.y) < 0 And oAngle > 80 Then
Call oLeaderPoints.Add(OTG.CreatePoint2d(oDrawingCurve.Position.X, oClick.y))
Call oLeaderPoints.Add(OTG.CreatePoint2d(oDrawingCurve.Position.X, oDrawingCurve.Position.y - (oDrawingCurve.Style.BalloonDiameter / 2)))
End If

If (oClick.y - oDrawingCurve.Position.y) > 0 And oAngle > 80 Then
Call oLeaderPoints.Add(OTG.CreatePoint2d(oDrawingCurve.Position.X, oClick.y))
Call oLeaderPoints.Add(OTG.CreatePoint2d(oDrawingCurve.Position.X, oDrawingCurve.Position.y + (oDrawingCurve.Style.BalloonDiameter / 2)))
End If

frmaddQTY.Show
MsgBox frmaddQTY.txtline1
ResultText = frmaddQTY.txtline1
Unload frmaddQTY
' Get the first symbol definition

Set oSketchSymDef = DrawDoc.SketchedSymbolDefinitions.Item("ABC")
sPromptStrings(1) = ResultText
If sPromptStrings(1) <> "" Then
sPromptStrings(1) = ResultText
Else
sPromptStrings(1) = "1"
End If
' Create the symbol with a leader

Set oSketchedSymbol = oActiveSheet.SketchedSymbols.AddWithLeader(oSketchSymDef, oLeaderPoints, 0, 1, sPromptStrings, True, False)

oSketchedSymbol.LeaderVisible = True

End Sub

Any help is appreciated.

JSR

[MDS-MQ]

I know you can place a sketch symbol and not show the leader and it will still attach to a balloon or other sketch symbol.

This is available if you place it from the Symbols dialog box.

[xiaodong_liang]

Hi,

after some investigation, I found there are some tricks here. Please refer to this blog.

http://adndevblog.typepad.com/manufacturing/2013/01/attach-a-sketched-symbol-to-a-balloon.html

In addition,  just a suggestion: when you provide a code demo, please make sure the neccessary functions/classes you defined are available, otherwise it will be very hard for peers on the forum to offer a hand. In the blog, I used a simplest code demo.