Crazyhoof 发表于 2010-5-28 11:02:00

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

第一次执行命令,圆可以动态显示,第二次执行命令的时候,圆就不能动态显示了,这段代码有什么问题呢,请大家指点迷津。


Imports Autodesk.AutoCAD.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
    <CommandMethod("mp")> 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

雪山飞狐_lzh 发表于 2010-5-28 19:30:00

用Jig实现,看看Kean专题中关于Jig的部分
页: [1]
查看完整版本: [求助]关于刷新实现动态效果的求救!