Here is VB.NET code
' Make sure if block "LEADERBLOCK" is exist
' and have 2 attributes "NUMBER" & "DESCRIPTION"
' Or change all above to your needs
' based on article from
' http://adndevblog.typepad.com/autocad/2012/05/how-to-create-mleader-objects-in-net.html
<CommandMethod("MBA")> _
Public Shared Sub netBlockMLeader()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = TryCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
Dim btr As BlockTableRecord = TryCast(tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
' Make sure if this block exist
If Not bt.Has("LEADERBLOCK") Then
ed.WriteMessage(vbLf & "You need to define a ""LEADERBLOCK"" first...")
Return
End If
Dim ppo As New PromptPointOptions(vbLf & "Pick arrow point >>")
Dim ptres As PromptPointResult
ptres = ed.GetPoint(ppo)
If ptres.Status <> PromptStatus.OK Then
Return
End If
Dim arrPt As Point3d = ptres.Value
ppo = New PromptPointOptions(vbLf & "Pick leader text point >>")
ppo.UseBasePoint = True
ppo.BasePoint = arrPt
ppo.UseDashedLine = True
ptres = ed.GetPoint(ppo)
If ptres.Status <> PromptStatus.OK Then
Return
End If
Dim textPt As Point3d = ptres.Value
Dim firsttxt As String
Dim pso As New PromptStringOptions(vbLf & "Enter text for attribute NUMBER: ")
pso.AllowSpaces = True
Dim res As PromptResult
res = ed.GetString(pso)
If res.Status <> PromptStatus.OK Then
Return
End If
firsttxt = res.StringResult
Dim sndtxt As String
pso.Message = vbLf & "Enter text for attribute DESCRIPTION: "
res = ed.GetString(pso)
If res.Status <> PromptStatus.OK Then
Return
End If
sndtxt = res.StringResult
Dim mlead As New MLeader()
mlead.SetDatabaseDefaults()
mlead.ContentType = ContentType.BlockContent
' Get ObjectId of mleader block
mlead.BlockContentId = bt("LEADERBLOCK")
mlead.BlockPosition = textPt
Dim idx As Integer = mlead.AddLeaderLine(arrPt)
mlead.AddFirstVertex(0, arrPt)
'Handle Block Attributes
Dim num As Integer = 0
Dim leadblk As BlockTableRecord = TryCast(tr.GetObject(mlead.BlockContentId, OpenMode.ForRead), BlockTableRecord)
'Doesn't take in consideration oLeader.BlockRotation
Dim mat As Matrix3d = Matrix3d.Displacement(mlead.BlockPosition.GetAsVector())
For Each attId As ObjectId In leadblk
Dim attdef As AttributeDefinition = TryCast(tr.GetObject(attId, OpenMode.ForRead), AttributeDefinition)
If attdef IsNot Nothing Then
Dim tag As String = attdef.Tag.ToUpper
Dim attref As New AttributeReference()
''---------------------------------------------''
Select Case tag
Case "NUMBER"
attref.SetAttributeFromBlock(attdef, mat)
attref.Position = attdef.Position.TransformBy(mat)
attref.TextString = firsttxt
mlead.SetBlockAttribute(attId, attref)
Case "DESCRIPTION"
attref.SetAttributeFromBlock(attdef, mat)
attref.Position = attdef.Position.TransformBy(mat)
attref.TextString = sndtxt
mlead.SetBlockAttribute(attId, attref)
'Case ETC ETC.....
End Select
End If
Next
btr.AppendEntity(mlead)
tr.AddNewlyCreatedDBObject(mlead, True)
tr.Commit()
End Using
End Sub
_____________________________________
C6309D9E0751D165D0934D0621DFF27919
