1、添加扩展数据
Private Sub 添加扩展数据(ByVal ent As Entity, ByVal DictName As String, ByVal TypedValue As TypedValue)
If ent.ExtensionDictionary = Nothing Then
ent.CreateExtensionDictionary()
End If
Using tr As Transaction = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.TransactionManager.StartTransaction
Dim xDict As DatabaseServices.DBDictionary = tr.GetObject(ent.ExtensionDictionary, OpenMode.ForWrite)
If Not xDict.Contains(DictName) Then
xDict.UpgradeOpen()
Dim xrec As New Xrecord
Dim rb As New ResultBuffer
rb.Add(TypedValue)
xrec.Data = rb
xDict.SetAt(DictName, xrec)
tr.AddNewlyCreatedDBObject(xrec, True)
End If
End Using
End Sub
2、读取扩展数据
Private Function 读取扩展数据(ByVal ent As Entity, ByVal DictName As String) As Object
Dim doc As Autodesk.AutoCAD.ApplicationServices.Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Using TR As Autodesk.AutoCAD.DatabaseServices.Transaction = doc.TransactionManager.StartTransaction
If ent.ExtensionDictionary.IsNull Then
Return Nothing
Else
Dim xDict As DBDictionary = CType(Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.TransactionManager.GetObject(ent.ExtensionDictionary, DatabaseServices.OpenMode.ForRead), DBDictionary)
If xDict.Contains(DictName) Then
Dim xRecId As ObjectId = xDict.GetAt(DictName)
Dim xRec As Xrecord = CType(TR.GetObject(xRecId, DatabaseServices.OpenMode.ForRead), Xrecord)
Return xRec.Data.AsArray(0).Value
Else
Return Nothing
End If
End If
End Using
End Function
来源:https://www.cnblogs.com/rf8862/p/12306121.html