<CommandMethod("attleader")> _
Public Shared Sub acedNEntSelPExTest()
Dim partDesc As String = ""
Dim partNum As String = ""
Dim matDesc As String = ""
Dim designer As String = ""
Dim length As String = ""
Dim width As String = ""
Dim createDate As String = ""
Dim matNum As String = ""
Dim makeBuy As String = ""
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
Dim id As New ObjectId
Dim adsname As Int64 = 0
Dim picked As Point3d
Dim xform As Matrix3d
Dim resbuf As IntPtr = IntPtr.Zero
Dim gsmarker As Integer = -1
Dim transflag As Integer = 1
Dim result As Integer = acedNEntSelPEx("Select Block(1):", adsname, picked, 0, xform, resbuf, _
transflag, gsmarker)
Dim db As Database = HostApplicationServices.WorkingDatabase
Using trans As Transaction = db.TransactionManager.StartTransaction()
If result = 5100 Then
If resbuf <> IntPtr.Zero Then
Dim buffer As ResultBuffer = DirectCast(DisposableWrapper.Create(GetType(ResultBuffer), resbuf, True), ResultBuffer)
Dim i As Integer = 0
For Each v As TypedValue In buffer
Dim ent As Entity = trans.GetObject(v.Value, OpenMode.ForRead, False)
If TypeOf ent Is BlockReference Then
Dim blkRef As BlockReference = TryCast(trans.GetObject(v.Value, OpenMode.ForRead, False), BlockReference)
Dim objId As ObjectId = blkRef.BlockTableRecord
Dim btr As BlockTableRecord = trans.GetObject(objId, OpenMode.ForRead)
If btr.IsFromExternalReference Then
Dim db2 As Database = New Database(False, False)
If File.Exists(btr.PathName) Then
db2.ReadDwgFile(btr.PathName, FileShare.ReadWrite, False, "")
Using trx2 As Transaction = db2.TransactionManager.StartTransaction()
Dim xrefBt As BlockTable = trx2.GetObject(db2.BlockTableId, OpenMode.ForWrite)
Dim btrMs2 As BlockTableRecord = trx2.GetObject(xrefBt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
For Each id2 As ObjectId In btrMs2
Dim ent2 As Entity = trx2.GetObject(id2, OpenMode.ForRead, False)
If TypeOf ent2 Is BlockReference Then
Dim blkref2 As BlockReference = TryCast(trx2.GetObject(id2, OpenMode.ForWrite, False), BlockReference)
Dim attrefIds As AttributeCollection = blkref2.AttributeCollection
For Each attrefid As ObjectId In attrefIds
Dim attref As AttributeReference = trx2.GetObject(attrefid, OpenMode.ForWrite, False)
Select Case attref.Tag
Case "PartDescription"
partDesc = attref.TextString
Case "PartNumber"
partNum = attref.TextString
Case "Designer"
designer = attref.TextString
Case "CreateDate"
createDate = attref.TextString
Case "MaterialNum"
matNum = attref.TextString
Case "MaterialDesc"
matDesc = attref.TextString
Case "Make-Buy"
makeBuy = attref.TextString
Case "Length"
length = attref.TextString
Case "Width"
width = attref.TextString
End Select
Next
End If
Next
End Using
End If
db2.Dispose()
'' Open the Block table for read
Dim acBlkTbl As BlockTable
acBlkTbl = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
'' Open the Block table record Model space for write
Dim acBlkTblRec As BlockTableRecord
acBlkTblRec = trans.GetObject(acBlkTbl(BlockTableRecord.PaperSpace), OpenMode.ForWrite)
''Get start point of the leader
Dim pr As PromptPointResult = ed.GetPoint(vbLf & "Specify leader arrowhead location: ")
If pr.Status <> PromptStatus.OK Then
Return
End If
Dim startPt As Point3d = pr.Value
''Get end point of leader
Dim opts As New PromptPointOptions(vbLf & "Specify landing location: ")
opts.BasePoint = startPt
opts.UseBasePoint = True
pr = ed.GetPoint(opts)
If pr.Status <> PromptStatus.OK Then
Return
End If
Dim endPt As Point3d = pr.Value
'' Create the leader with annotation
Dim acLdr As New MLeader()
Dim ldNum As Integer = acLdr.AddLeader()
Dim lnNum As Integer = acLdr.AddLeaderLine(ldNum)
acLdr.AddFirstVertex(lnNum, startPt)
acLdr.AddLastVertex(lnNum, endPt)
acLdr.LeaderLineType = LeaderType.StraightLeader
''Create the MText
Dim mt As New MText()
mt.Contents = "Part Number: " & partNum & vbLf & _
"Part Description: " & partDesc & vbLf & _
"Material Number: " & matNum & vbLf & _
"Material Desc.: " & matDesc & vbLf & _
"Make-Buy: " & makeBuy
mt.Location = endPt
mt.TextHeight = 0.05
acLdr.ContentType = ContentType.MTextContent
acLdr.MText = mt
'' Add the new object to paper space and the transaction
acBlkTblRec.AppendEntity(acLdr)
trans.AddNewlyCreatedDBObject(acLdr, True)
End If
End If
Next
buffer.Dispose()
End If
End If
trans.Commit()
End Using
End Sub
<DllImport("acad.exe", EntryPoint:="?acedNEntSelPEx@@YAHPEB_WQEA_JQEANHQEAY03NPEAPEAUresbuf@@IPEA_J@Z", CallingConvention:=CallingConvention.Cdecl, CharSet:=CharSet.Unicode)> _
Private Shared Function acedNEntSelPEx(ByVal prompt As String, ByRef adsname As Int64, ByRef picked As Point3d, ByVal pickflag As Integer, ByRef transform As Matrix3d, ByRef resbuf As IntPtr, ByVal transSpaceFlag As UInteger, ByRef gsMarker As Integer) As Integer
End Function
