Imports System.Xml

Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry

Public Class MyCircle
    Private fCenter As Point3d
    Private fRadius As Double

    Private OID As ObjectId
    Private textID As ObjectId

    Public Sub New(cp As Point3d, r As Double, db As Database)
        Me.fCenter = cp
        Me.fRadius = R
        '
        Me.DrawMe(db)
        Me.DrawLebel()
    End Sub

    Public Sub New(MyCircleData As XmlElement, db As Database)
        Dim wHandle As New Handle(Long.Parse(MyCircleData.GetAttribute("Handle"), Globalization.NumberStyles.HexNumber))
        OID = New ObjectId
        Me.fCenter = Me.ParsePoint(MyCircleData.GetAttribute("Center"))
        Me.fRadius = MyCircleData.GetAttribute("Radius")
        If db.TryGetObjectId(wHandle, OID) Then
            Me.UpgradeMe()
        Else
            Me.DrawMe(db)
        End If
        Me.DrawLebel()
    End Sub

    Public Sub UpgradeMe()
        Using acTrans As Transaction = OID.Database.TransactionManager.StartTransaction()
            Dim wDBObj As Circle = OID.GetObject(OpenMode.ForWrite)
            RemoveHandler wDBObj.Modified, AddressOf CirMod
            wDBObj.Radius = Me.fRadius
            wDBObj.Center = Me.fCenter
            wDBObj.UpgradeOpen()
            AddHandler wDBObj.Modified, AddressOf CirMod
            acTrans.Commit()
        End Using
    End Sub

    Public Sub UpgradeLabel()
        Using acTrans As Transaction = OID.Database.TransactionManager.StartTransaction()
            Dim acText As DBText = textID.GetObject(OpenMode.ForWrite)
            acText.Position = Me.fCenter
            acText.TextString = Me.fRadius
            acText.UpgradeOpen()
            acTrans.Commit()
        End Using
    End Sub

    Public Sub DrawMe(db As Database)
        Using acTrans As Transaction = db.TransactionManager.StartTransaction()
            Dim cNewCircle As New Circle(Me.fCenter, New Vector3d(0, 0, 1), Me.fRadius)
            'получаем текущее пространство чертежа (может быть модель или лист)
            Dim btrCurrSpace As BlockTableRecord = acTrans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)
            'добавляем в текущее пространство наш созданный примитив
            OID = btrCurrSpace.AppendEntity(cNewCircle)
            acTrans.AddNewlyCreatedDBObject(cNewCircle, True)
            AddHandler cNewCircle.Modified, AddressOf CirMod
            'завершаем транзакцию
            acTrans.Commit()
        End Using
    End Sub

    Public Sub DrawLebel()
        If textID.IsNull Then
            Using acTrans As Transaction = OID.Database.TransactionManager.StartTransaction()
                Dim acBlkTbl As BlockTable
                acBlkTbl = acTrans.GetObject(OID.Database.BlockTableId, OpenMode.ForRead)
                Dim acBlkTblRec As BlockTableRecord
                acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
                Dim acText As New DBText()
                acText.SetDatabaseDefaults()
                acText.Position = Me.fCenter
                acText.Height = 2
                acText.TextString = Me.fRadius
                textID = acBlkTblRec.AppendEntity(acText)
                acTrans.AddNewlyCreatedDBObject(acText, True)
                acTrans.Commit()
            End Using
        End If
    End Sub

    Public Sub EraseLebel()
        If Not textID.IsNull Then
            Using acTrans As Transaction = OID.Database.TransactionManager.StartTransaction()
                Dim wDBObj As DBText = textID.GetObject(OpenMode.ForWrite)
                wDBObj.Erase()
                wDBObj.UpgradeOpen()
                acTrans.Commit()
            End Using
        End If
    End Sub

    Public Sub CirMod(ByVal senderObj As Object, ByVal evtArgs As EventArgs)
            Using acTrans As Transaction = OID.Database.TransactionManager.StartTransaction()
                Dim wDBObj As Circle = OID.GetObject(OpenMode.ForRead)
                Me.fCenter = wDBObj.Center
                Me.fRadius = wDBObj.Radius
                UpgradeLabel()
                acTrans.Commit()
            End Using
    End Sub

    Private Function ParsePoint(wStr As String) As Point3d
        wStr = wStr.Replace("(", "")
        wStr = wStr.Replace(")", "")
        Dim Arr() As String = wStr.Split(",")
        Return New Point3d(Double.Parse(Arr(0)), Double.Parse(Arr(1)), Double.Parse(Arr(2)))
    End Function

    Public Property Center As Point3d
        Get
            Return Me.fCenter
        End Get
        Set(value As Point3d)
            Me.fCenter = value
            Me.UpgradeMe()
        End Set
    End Property

    Public Sub Print(wEditor As Editor)
        Using acTrans As Transaction = OID.Database.TransactionManager.StartTransaction()
            wEditor.WriteMessage("Handle: " & OID.Handle.ToString & Environment.NewLine)
            Dim wDBObj As Circle = OID.GetObject(OpenMode.ForRead)
            wEditor.WriteMessage("Radius: " & wDBObj.Radius & Environment.NewLine)
            wEditor.WriteMessage("Center: " & wDBObj.Center.ToString & Environment.NewLine)
        End Using
    End Sub

    Public Function ToXML(wDoc As XmlDocument) As XmlElement
        Dim res As XmlElement = wDoc.CreateElement("MyCircle")
        Using acTrans As Transaction = OID.Database.TransactionManager.StartTransaction()
            res.SetAttribute("Handle", Me.OID.Handle.ToString)
            Dim wDBObj As Circle = OID.GetObject(OpenMode.ForRead)
            res.SetAttribute("Radius", wDBObj.Radius)
            res.SetAttribute("Center", wDBObj.Center.ToString)
        End Using
        Return res
    End Function

End Class

Imports Autodesk.AutoCAD.Runtime
Imports AppServ = Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry

Imports System.Windows.Forms
Imports System.Xml

Public Class CommandClass
    Dim wList As List(Of MyCircle) = Nothing

    <CommandMethod("CrMyCircle")> _
    Public Sub CrMyCircle()
        If wList Is Nothing Then wList = New List(Of MyCircle)
        Dim acDoc As AppServ.Document = AppServ.Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database
        Dim pPtRes As PromptPointResult = acDoc.Editor.GetPoint("Укажите центр: ")
        If (pPtRes.Status = PromptStatus.OK) Then
            Dim wPrmtDistOpt As New PromptDistanceOptions("Укажите радиус: ")
            wPrmtDistOpt.BasePoint = pPtRes.Value
            wPrmtDistOpt.UseBasePoint = True
            Dim pDistRes As PromptDoubleResult = acDoc.Editor.GetDistance(wPrmtDistOpt)
            If (pDistRes.Status = PromptStatus.OK) Then
                wList.Add(New MyCircle(pPtRes.Value, pDistRes.Value, acCurDb))
            End If
        End If
    End Sub

    <CommandMethod("SaveToXML")> _
    Public Sub SaveToXML()
        Dim nDialog As New SaveFileDialog
        nDialog.Filter = "XML|*.xml"
        Dim wDoc As New XmlDocument
        wDoc.LoadXml("<?xml version=""1.0"" encoding=""utf-8""?><MyCircleList/>")
        If wList IsNot Nothing Then wList.ForEach(Sub(obj) wDoc.DocumentElement.AppendChild(obj.ToXML(wDoc)))
        If nDialog.ShowDialog = DialogResult.OK Then
            wDoc.Save(nDialog.FileName)
        End If
    End Sub

    <CommandMethod("LoadFromXML")> _
    Public Sub LoadFromXML()
        Dim nDialog As New OpenFileDialog
        nDialog.Filter = "XML|*.xml"
        Dim wDoc As New XmlDocument
        Dim done As Boolean = False
        If nDialog.ShowDialog = DialogResult.OK Then
            wDoc.Load(nDialog.FileName)
            done = True
        End If
        If done Then
            If wList Is Nothing Then wList = New List(Of MyCircle)
            Dim acDoc As AppServ.Document = AppServ.Application.DocumentManager.MdiActiveDocument
            Dim acCurDb As Database = acDoc.Database
            For Each ch In wDoc.DocumentElement.ChildNodes
                wList.Add(New MyCircle(ch, acCurDb))
            Next
        End If
    End Sub

    <CommandMethod("DrawLabel")> _
    Public Sub DrawLabel()
        If wList IsNot Nothing Then wList.ForEach(Sub(obj) obj.DrawLebel())
    End Sub

    <CommandMethod("EraseLabel")> _
    Public Sub EraseLabel()
        If wList IsNot Nothing Then wList.ForEach(Sub(obj) obj.EraseLebel())
    End Sub

End Class