[求助]关于刷新实现动态效果的求救！

 
 
Imports Autodesk..ApplicationServices
Imports Autodesk.AutoCAD.Colors
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.GraphicsSystem
Imports Autodesk.AutoCAD.GraphicsInterface
Imports Autodesk.AutoCAD.Windows
Imports Autodesk.AutoCAD.Publishing
Imports Autodesk.AutoCAD.PlottingServices
Imports Autodesk.AutoCAD.ComponentModel
Imports Autodesk.AutoCAD.LayerManager
Public Class Class1
    Private MousePoint As Point3d = New Point3d(0, 0, 0) '保存当前鼠标位置
    Shared Cr As Circle
     Public Sub test()
        Dim Db As Database = HostApplicationServices.WorkingDatabase
        Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
        Dim Doc As Document = Application.DocumentManager.MdiActiveDocument
        Using LckDoc As DocumentLock = Doc.LockDocument
            Using Trans As Transaction = Db.TransactionManager.StartTransaction()
                Try
                    Dim Bt As BlockTable = Trans.GetObject(Db.BlockTableId, OpenMode.ForRead)
                    Dim Btr As BlockTableRecord = Trans.GetObject(Bt.Item(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
                    
                    Cr = New Circle
                    Cr.SetDatabaseDefaults()
                    Cr.Radius = 10
                    Cr.Center = New Point3d(0, 0, 0)
                    Btr.AppendEntity(Cr)
                    Trans.AddNewlyCreatedDBObject(Cr, True)
                    ed.WriteMessage("new后圆id:" + Cr.ObjectId.ToString)
                    Dim pro As PromptPointOptions = New PromptPointOptions("按左键退出...")
                    AddHandler ed.PointFilter, AddressOf GetMousePoint
                    Dim res As PromptPointResult = ed.GetPoint(pro)
                    Dim Po1 As Point3d = res.Value
                    RemoveHandler ed.PointFilter, AddressOf GetMousePoint
                    Cr.ColorIndex = 1
                    Trans.Commit()
                Catch ex As System.Exception
                    MsgBox("Error : " + ex.Message)
                Finally
                End Try
            End Using
        End Using
 
    End Sub    ''动态获取鼠标位置  
    Private Sub GetMousePoint(ByVal sender As Object, ByVal e As PointFilterEventArgs)
        MousePoint = e.Context.ComputedPoint
        Dim Db As Database = HostApplicationServices.WorkingDatabase
        Dim Ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Dim Doc As Document = Application.DocumentManager.MdiActiveDocument
        Using LckDoc As DocumentLock = Doc.LockDocument
            Using Trans As Transaction = Db.TransactionManager.StartTransaction()
                Try
                    Dim Pt1 As Point3d = New Point3d(0, 0, 0)
                    Cr.Radius = New Line(MousePoint, Pt1).Length / 2
                    Cr.Center = MousePoint
                    Doc.Editor.Regen()
                    Ed.WriteMessage("圆id:" + Cr.ObjectId.ToString)
                    Trans.Commit()
                Catch ex As System.Exception
                    MsgBox("Error : " + ex.Message)
                Finally
                End Try
            End Using
        End Using
    End Sub
End Class