Question

我正在尝试编写属性“注入”工具 - 也就是说，它会提示您输入属性的名称，插入它的点，然后将其插入块定义（不仅仅是引用），然后同步本地块引用。

这就是我所拥有的：

<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

我不知道为什么这不起作用，它很乐意在属性所在的点周围插入圆圈，但即使在块编辑器中也不会出现该属性。

我错过了什么？

P.S。如果您愿意，我可以在C＃中互换工作！

Answer 1

对，修好了。基本上我并没有真正理解AttributeDefinition的机制：

出于某种原因，您必须设置attDef.Invisible而不是attDef.Visible。为什么两者都存在我不知道。
我遇到的问题似乎总是插在块的原点，但我发现你还必须设置attDef.Alignment点。
最后，我的RecordGraphicsModified方法并没有同步这些属性，我还没有对它进行整理。

编辑：如果有人想知道属性同步的事情，我在这里使用了Gilles Chanteau的解决方案：https://forums.autodesk.com/t5/net/attsync-in-vb-net/td-p/4645057

Autocad .NET将属性添加到块定义

1 个答案: