Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Public Class 实体移动
    <CommandMethod("EntMove")> _
        Public Sub EntMove()
        Dim db As Database = Application.DocumentManager.MdiActiveDocument.Database
        Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        '选择轨迹
        Dim opt As New PromptEntityOptions("选择轨迹")
        opt.SetRejectMessage(vbLf & "选择轨迹")
        opt.AddAllowedClass(GetType(Ellipse), True)
        opt.AddAllowedClass(GetType(Arc), True)
        opt.AddAllowedClass(GetType(Circle), True)
        opt.AddAllowedClass(GetType(Line), True)
        opt.AddAllowedClass(GetType(Polyline), True)
        opt.AddAllowedClass(GetType(Spline), True)
        Dim res As PromptEntityResult = ed.GetEntity(opt)
        If res.Status = PromptStatus.OK Then
            Using trans As Transaction = db.TransactionManager.StartTransaction()
                Dim bt As BlockTable = DirectCast(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
                Dim btr As BlockTableRecord = DirectCast(trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
                Dim ent As Entity = TryCast(trans.GetObject(res.ObjectId, OpenMode.ForRead), Entity)
                '创建沿轨迹运行的实体
                Dim c As Curve = TryCast(ent, Curve)
                If c IsNot Nothing Then
                    Dim p As New DBPoint()
                    p.ColorIndex = 1
                    p.Position = c.StartPoint
                    btr.AppendEntity(p)
                    trans.AddNewlyCreatedDBObject(p, True)
                    trans.Commit()
                    ed.UpdateScreen()
                    System.Threading.Thread.Sleep(1000)
                    Dim pt As Point3d = Point3d.Origin
                    Dim k As Integer = 0
                    While pt <> c.EndPoint
                        Try
                            k += 1
                            pt = c.GetPointAtDist(40.0 * k)
                            '实体运行的速度
                            AlongMove(c, p.ObjectId, pt)
                        Catch
                            pt = c.EndPoint
                        End Try
                    End While
                End If
            End Using
        End If
    End Sub
    Private Sub AlongMove(ByVal c As Curve, ByVal objId As ObjectId, ByVal pt As Point3d)
        Dim db As Database = Application.DocumentManager.MdiActiveDocument.Database
        Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Dim p As DBPoint = TryCast(trans.GetObject(objId, OpenMode.ForWrite), DBPoint)
            Dim m As Matrix3d = Matrix3d.Displacement(p.Position.GetVectorTo(pt))
            p.TransformBy(m)
            trans.Commit()
            If p.Position = c.EndPoint Then
                Return
            End If
            ed.UpdateScreen()
            System.Threading.Thread.Sleep(100)
        End Using
    End Sub
End Class