【发布时间】:2015-11-16 06:24:08
【问题描述】:
我正在尝试编写一个属性“注入”工具——也就是说,它会提示您输入属性的名称、插入它的点,然后将其插入到块定义中(不仅仅是引用),然后同步本地块引用。
这是我得到的:
<CommandMethod("INJECTOR", CommandFlags.Session)>
Sub Injector()
Dim doc As Document = DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim acdb As Database = doc.Database
Dim opts As New PromptEntityOptions(vbNewLine & "Select Block:")
Dim res As PromptEntityResult = ed.GetEntity(opts)
If res.Status <> PromptStatus.OK Then Exit Sub
Dim id As ObjectId = res.ObjectId
Using doc.LockDocument
Using tr As Transaction = doc.Database.TransactionManager.StartTransaction
Dim blk As BlockReference = tr.GetObject(id, OpenMode.ForRead)
Dim blkName As String = blk.Name.ToUpper()
Dim bt As BlockTable = tr.GetObject(acdb.BlockTableId, OpenMode.ForRead)
Dim btr As BlockTableRecord = tr.GetObject(bt(blkName), OpenMode.ForWrite)
If btr.Name.ToUpper() = blkName Then
btr.UpgradeOpen()
Dim brefIds As ObjectIdCollection = btr.GetBlockReferenceIds(False, True)
Dim stropts As New PromptStringOptions(vbNewLine & "Attribute Name:")
Dim strres As PromptResult = ed.GetString(stropts)
If strres.Status <> PromptStatus.OK OrElse strres.StringResult = "CANCEL" Then Exit Sub
Dim attName As String = strres.StringResult
Dim posopts As New PromptPointOptions(vbNewLine & "Select Point:")
Dim pntres As PromptPointResult = ed.GetPoint(posopts)
If pntres.Status <> PromptStatus.OK Then Exit Sub
Dim pnt3d As New Point3d(pntres.Value.X - blk.Position.X, pntres.Value.Y - blk.Position.Y, pntres.Value.Z - blk.Position.Z)
ed.WriteMessage(vbNewLine & "Adding attribute called " & attName & " at " & pnt3d.X & "," & pnt3d.Y & "," & pnt3d.Z)
Dim attDef As New AttributeDefinition()
attDef.Position = pnt3d
attDef.AlignmentPoint = pnt3d
attDef.Verifiable = True
attDef.Tag = attName
attDef.Justify = AttachmentPoint.MiddleCenter
attDef.Invisible = True
attDef.Height = 3
btr.AppendEntity(attDef)
tr.AddNewlyCreatedDBObject(attDef, True)
Dim circ As New Circle()
circ.Center = pnt3d
circ.Radius = 2
btr.AppendEntity(circ)
tr.AddNewlyCreatedDBObject(circ, True)
btr.DowngradeOpen()
ed.WriteMessage(vbNewLine & "Updating existing block references.")
For Each objid As ObjectId In brefIds
Dim bref As BlockReference = tr.GetObject(objid, OpenMode.ForWrite, False, True)
bref.RecordGraphicsModified(True)
Next
End If
tr.Commit()
End Using
End Using
End Sub
我不知道为什么这不起作用,它很乐意在属性应该在的点周围插入圆圈,但属性没有出现,即使在块编辑器中也是如此。
我错过了什么?
附:如果您愿意,我可以在 C# 中互换工作!
【问题讨论】:
标签: c# .net vb.net autocad-plugin