This works great for me. Is it also possible to change the code for me so I get Balloons instead of notes? I need this to get a Grid. So Ideal would be If I get a balloon on top and at the bottom of the line in the drawing.
At the moment I'm using this code:
Public Sub Plane_name()
Dim oDoc As DrawingDocument
Set oDoc = ThisApplication.ActiveDocument
Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry
Dim oActiveSheet As Sheet
Set oActiveSheet = oDoc.ActiveSheet
Dim oCenterLine As Centerline
For Each oCenterLine In oActiveSheet.Centerlines
If Not oCenterLine.ModelWorkFeature Is Nothing Then
'select start point or end point as the position for the drawing note
Dim oPos As Point2d
Dim oStPos As Point2d
Set oStPos = oCenterLine.StartPoint
Dim oEndPos As Point2d
Set oEndPos = oCenterLine.EndPoint
If Math.Abs(oStPos.X - oEndPos.X) > Math.Abs(oStPos.Y - oEndPos.Y) Then
' put drawing note at the right of the center line
If oStPos.X > oEndPos.X Then
' set position of drawing note at start point
Set oPos = oStPos
Else
' set position of drawing note at end point
Set oPos = oEndPos
End If
Else
' put drawing note at the bottom of the center line
If oStPos.Y > oEndPos.Y Then
' set position of drawing note at end point
Set oPos = oEndPos
Else
' set position of drawing note at start point
Set oPos = oStPos
End If
End If
Dim oWP_Name As String
oWP_Name = oCenterLine.ModelWorkFeature.Name
Dim oLeaderPoints As ObjectCollection
Set oLeaderPoints = ThisApplication.TransientObjects.CreateObjectCollection()
Call oLeaderPoints.Add(oTG.CreatePoint2d(oPos.X, oPos.Y))
' Create geometry intent from position
Dim oGeometryIntent As GeometryIntent
Set oGeometryIntent = oActiveSheet.CreateGeometryIntent(oCenterLine, oPos)
Call oLeaderPoints.Add(oGeometryIntent)
' add leader note
Dim oLeaderNote As LeaderNote
Call oActiveSheet.DrawingNotes.LeaderNotes.Add(oLeaderPoints, oWP_Name)
End If
Next
End Sub
