[求助]关于刷新实现动态效果的求救!
第一次执行命令,圆可以动态显示,第二次执行命令的时候,圆就不能动态显示了,这段代码有什么问题呢,请大家指点迷津。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
用Jig实现,看看Kean专题中关于Jig的部分
页:
[1]