Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Runtime
Namespace ExtendedEntityData
Public Class Commands
<CommandMethod("GXD")> _
Public Shared Sub GetXData()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
' Ask the user to select an entity
' for which to retrieve XData
Dim opt As New PromptEntityOptions(vbLf & "Select entity: ")
Dim res As PromptEntityResult = ed.GetEntity(opt)
If res.Status = PromptStatus.OK Then
Dim tr As Transaction = doc.TransactionManager.StartTransaction()
Using tr
Dim obj As DBObject = tr.GetObject(res.ObjectId, OpenMode.ForRead)
Dim rb As ResultBuffer = obj.XData
If rb Is Nothing Then
ed.WriteMessage(vbLf & "Entity does not have XData attached.")
Else
Dim n As Integer = 0
For Each tv As TypedValue In rb
ed.WriteMessage(vbLf & "TypedValue {0} - type: {1}, value: {2}", System.Math.Max(System.Threading.Interlocked.Increment(n), n - 1), tv.TypeCode, tv.Value)
Next
rb.Dispose()
End If
End Using
End If
End Sub
<CommandMethod("SXD")> _
Public Shared Sub SetXData()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
' Ask the user to select an entity
' for which to set XData
Dim opt As New PromptEntityOptions(vbLf & "Select entity: ")
Dim res As PromptEntityResult = ed.GetEntity(opt)
If res.Status = PromptStatus.OK Then
Dim tr As Transaction = doc.TransactionManager.StartTransaction()
Using tr
Dim obj As DBObject = tr.GetObject(res.ObjectId, OpenMode.ForWrite)
AddRegAppTableRecord("KEAN")
Dim rb As New ResultBuffer(New TypedValue(1001, "KEAN"), New TypedValue(1000, "This is a test string"))
obj.XData = rb
rb.Dispose()
tr.Commit()
End Using
End If
End Sub
Shared Sub AddRegAppTableRecord(ByVal regAppName As String)
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim db As Database = doc.Database
Dim tr As Transaction = doc.TransactionManager.StartTransaction()
Using tr
Dim rat As RegAppTable = CType(tr.GetObject(db.RegAppTableId, OpenMode.ForRead, False), RegAppTable)
If Not rat.Has(regAppName) Then
rat.UpgradeOpen()
Dim ratr As New RegAppTableRecord()
ratr.Name = regAppName
rat.Add(ratr)
tr.AddNewlyCreatedDBObject(ratr, True)
End If
tr.Commit()
End Using
End Sub
End Class
End Namespace
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Runtime
Namespace ExtendedEntityData
Public Class Commands
<CommandMethod("GXD")> _
Public Shared Sub GetXData()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
' Ask the user to select an entity
' for which to retrieve XData
Dim opt As New PromptEntityOptions(vbLf & "Select entity: ")
Dim res As PromptEntityResult = ed.GetEntity(opt)
If res.Status = PromptStatus.OK Then
Dim tr As Transaction = doc.TransactionManager.StartTransaction()
Using tr
Dim obj As DBObject = tr.GetObject(res.ObjectId, OpenMode.ForRead)
Dim rb As ResultBuffer = obj.XData
If rb Is Nothing Then
ed.WriteMessage(vbLf & "Entity does not have XData attached.")
Else
Dim n As Integer = 0
For Each tv As TypedValue In rb
ed.WriteMessage(vbLf & "TypedValue {0} - type: {1}, value: {2}", System.Math.Max(System.Threading.Interlocked.Increment(n), n - 1), tv.TypeCode, tv.Value)
Next
rb.Dispose()
End If
End Using
End If
End Sub
<CommandMethod("SXD")> _
Public Shared Sub SetXData()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
' Ask the user to select an entity
' for which to set XData
Dim opt As New PromptEntityOptions(vbLf & "Select entity: ")
Dim res As PromptEntityResult = ed.GetEntity(opt)
If res.Status = PromptStatus.OK Then
Dim tr As Transaction = doc.TransactionManager.StartTransaction()
Using tr
Dim obj As DBObject = tr.GetObject(res.ObjectId, OpenMode.ForWrite)
AddRegAppTableRecord("KEAN")
Dim rb As New ResultBuffer(New TypedValue(1001, "KEAN"), New TypedValue(1000, "This is a test string"))
obj.XData = rb
rb.Dispose()
tr.Commit()
End Using
End If
End Sub
Shared Sub AddRegAppTableRecord(ByVal regAppName As String)
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim db As Database = doc.Database
Dim tr As Transaction = doc.TransactionManager.StartTransaction()
Using tr
Dim rat As RegAppTable = CType(tr.GetObject(db.RegAppTableId, OpenMode.ForRead, False), RegAppTable)
If Not rat.Has(regAppName) Then
rat.UpgradeOpen()
Dim ratr As New RegAppTableRecord()
ratr.Name = regAppName
rat.Add(ratr)
tr.AddNewlyCreatedDBObject(ratr, True)
End If
tr.Commit()
End Using
End Sub
End Class
End Namespace
原文:http://through-the-interface.typepad.com/throu ... 007/04/adding_xdata_to.html
http://adndevblog.typepad.com/autocad/2012/0 ... -add-and-remove-xdata-.html
[本日志由 tiancao1001 于 2016-10-10 11:16 PM 编辑]
|
暂时没有评论
发表评论 - 不要忘了输入验证码哦! |