2007仿2012copy

Public Class Jig_CCopy
    ' 从DrawJig类继承.
    Inherits DrawJig
    ' 声明全局变量.
    Dim sourcePt, targetPt, curPt As Point3d
    Dim keyword As String
    Dim i, k, few As Integer
    Dim entCopy(,), entCopy1(), oldEnt() As Entity, ids As ObjectId()
    Dim db As Database = HostApplicationServices.WorkingDatabase
    Dim doc As Document = Application.DocumentManager.MdiActiveDocument
    Dim ed As Editor = doc.Editor
     Sub testCCopy()
        keyword = "C"
        Dim res As PromptSelectionResult
        Dim sSet As SelectionSet
        Dim opt As New PromptSelectionOptions
        res = ed.SelectImplied()
        If res.Status = PromptStatus.OK Then
            sSet = res.Value
            ids = sSet.GetObjectIds()
        Else
            ' 选择集交互操作
            opt.MessageForAdding = "请选择对象:"
            opt.AllowDuplicates = True
            res = ed.GetSelection(opt)
            If res.Status  PromptStatus.OK Then Return
            sSet = res.Value
            ids = sSet.GetObjectIds()
        End If
        ' 得到基点
        Dim optPoint As New PromptPointOptions(vbCrLf & "请输入基点:")
        optPoint.AllowNone = True
        Dim resPoint As PromptPointResult = ed.GetPoint(optPoint)
        If resPoint.Status  PromptStatus.OK Then Return
        sourcePt = resPoint.Value
        ReDim entCopy1(ids.Length - 1)
        ReDim oldEnt(ids.Length - 1)
        '获取对象
        Using trans As Transaction = db.TransactionManager.StartTransaction()
            For i = 0 To ids.Length - 1
                oldEnt(i) = trans.GetObject(ids(i), OpenMode.ForWrite)
            Next
            trans.Commit()
        End Using
        Dim lop As Boolean = True
        '循环
        Do While lop = True
            For i = 0 To ids.Length - 1
                ' 将源对象设置为高亮
                oldEnt(i).Highlight()
                ' 复制
                entCopy1(i) = oldEnt(i).Clone()
            Next
            ' 设置目标点和拖拽临时点
            targetPt = sourcePt
            curPt = targetPt
            ' 开始拖拽.
            Dim jigRes As PromptResult = ed.Drag(Me)
            If jigRes.Status = PromptStatus.OK Then
                For i = 0 To ids.Length - 1
                    AppendEntity(entCopy1(i))
                Next
            ElseIf keyword = "A" Then
                targetPt = sourcePt
                curPt = targetPt
                ' 开始拖拽.
                jigRes = ed.Drag(Me)
                If jigRes.Status = PromptStatus.OK Then
                    For k = 0 To few - 1
                        For i = 0 To ids.Length - 1
                            AppendEntity(entCopy(k, i))
                        Next
                    Next
                    ' 取消源对象的高亮状态.
                    For i = 0 To ids.Length - 1
                        oldEnt(i).Unhighlight()
                    Next
                    '结束循环
                    lop = False
                ElseIf keyword = "F" Then
                    targetPt = sourcePt
                    curPt = targetPt
                    ' 开始拖拽.
                    jigRes = ed.Drag(Me)
                    If jigRes.Status = PromptStatus.OK Then
                        For k = 0 To few - 1
                            For i = 0 To ids.Length - 1
                                AppendEntity(entCopy(k, i))
                            Next
                        Next
                        ' 取消源对象的高亮状态.
                        For i = 0 To ids.Length - 1
                            oldEnt(i).Unhighlight()
                        Next
                        lop = False
                    Else
                        lop = False
                        ' 取消源对象的高亮状态.
                        For i = 0 To ids.Length - 1
                            oldEnt(i).Unhighlight()
                        Next
                    End If
                Else
                    lop = False
                    ' 取消源对象的高亮状态.
                    For i = 0 To ids.Length - 1
                        oldEnt(i).Unhighlight()
                    Next
                End If
            Else
                lop = False
                ' 取消源对象的高亮状态.
                For i = 0 To ids.Length - 1
                    oldEnt(i).Unhighlight()
                Next
            End If
        Loop
    End Sub
    ' Sampler函数用于检测用户的输入.
    Protected Overrides Function Sampler(ByVal prompts As JigPrompts) As SamplerStatus
        If keyword = "C" Then
            Dim optJig As New JigPromptPointOptions(vbCrLf & "请指定第二点[阵列(A)]:")
            ' 设置拖拽光标类型.
            optJig.Cursor = CursorType.RubberBand
            ' 设置拖动光标基点.
            optJig.BasePoint = sourcePt
            optJig.UseBasePoint = True
            '为optJig添加关键字
            optJig.Keywords.Add("A", "A", "A", False, True)
            'optJig.Keywords.Add("C", "C", "C", False, True)
            ''默认关键字
            'optJig.Keywords.Default = "C"
            ' 用AcquirePoint函数得到用户输入的点.
            Dim resJig As PromptPointResult = prompts.AcquirePoint(optJig)
            targetPt = resJig.Value
            ' 如果用户拖拽，则用矩阵变换的方法移动选择集中的全部对象.
            If resJig.Status = PromptStatus.Keyword Then
                keyword = "A"
                '获取等分数量
                Dim optfew As New PromptIntegerOptions(vbCrLf & "请输入等分数量")
                Dim resfew As PromptIntegerResult = ed.GetInteger(optfew)
                If resfew.Status  PromptStatus.OK Then Return True
                few = resfew.Value
                ReDim entCopy(0 To few - 1, ids.Length - 1)
                For k = 0 To few - 1
                    For i = 0 To ids.Length - 1
                        ' 复制.
                        entCopy(k, i) = oldEnt(i).Clone()
                    Next
                Next
            Else
                If curPt  targetPt Then
                    Dim moveMt As Matrix3d = Matrix3d.Displacement(targetPt - curPt)
                    For i = 0 To ids.Length - 1
                        entCopy1(i).TransformBy(moveMt)
                    Next
                    ' 保存当前点.
                    curPt = targetPt
                    Return SamplerStatus.OK
                Else
                    Return SamplerStatus.NoChange
                End If
            End If
        ElseIf keyword = "A" Then
            ' 定义一个点拖动交互类.
            Dim optJig As New JigPromptPointOptions(vbCrLf & "请指定第二点[布满(F)]:")
            ' 设置拖拽光标类型.
            optJig.Cursor = CursorType.RubberBand
            ' 设置拖动光标基点.
            optJig.BasePoint = sourcePt
            optJig.UseBasePoint = True
            '为optJig添加关键字
            optJig.Keywords.Add("F", "F", "F", False, True)
            'optJig.Keywords.Add("C", "C", "C", False, True)
            ''默认关键字
            'optJig.Keywords.Default = "C"
            ' 用AcquirePoint函数得到用户输入的点.
            Dim resJig As PromptPointResult = prompts.AcquirePoint(optJig)
            targetPt = resJig.Value
            If resJig.Status = PromptStatus.Keyword Then
                keyword = "F"
                For k = 0 To few - 1
                    For i = 0 To ids.Length - 1
                        ' 复制.
                        entCopy(k, i) = oldEnt(i).Clone()
                    Next
                Next
            Else
                If curPt  targetPt Then
                    'Dim moveMt As Matrix3d = Matrix3d.Displacement((targetPt - curPt) / few * (k + 1))
                    For k = 0 To few - 1
                        For i = 0 To ids.Length - 1
                            entCopy(k, i).TransformBy(Matrix3d.Displacement((targetPt - curPt) * (k + 1)))
                        Next
                    Next
                    ' 保存当前点.
                    curPt = targetPt
                    Return SamplerStatus.OK
                Else
                    Return SamplerStatus.NoChange
                End If
            End If
        ElseIf keyword = "F" Then
            ' 定义一个点拖动交互类.
            Dim optJig As New JigPromptPointOptions(vbCrLf & "请指定第二点:")
            ' 设置拖拽光标类型.
            optJig.Cursor = CursorType.RubberBand
            ' 设置拖动光标基点.
            optJig.BasePoint = sourcePt
            optJig.UseBasePoint = True
            ' 用AcquirePoint函数得到用户输入的点.
            Dim resJig As PromptPointResult = prompts.AcquirePoint(optJig)
            targetPt = resJig.Value
            ' 如果用户拖拽，则用矩阵变换的方法移动选择集中的全部对象.
            If curPt  targetPt Then
                'Dim moveMt As Matrix3d = Matrix3d.Displacement((targetPt - curPt) / few * (k + 1))
                For k = 0 To few - 1
                    For i = 0 To ids.Length - 1
                        entCopy(k, i).TransformBy(Matrix3d.Displacement((targetPt - curPt) / few * (k + 1)))
                    Next
                Next
                ' 保存当前点.
                curPt = targetPt
                Return SamplerStatus.OK
            Else
                Return SamplerStatus.NoChange
            End If
        End If
    End Function
 ' WorldDraw函数用于刷新屏幕上显示的图形.
    Protected Overrides Function WorldDraw(ByVal draw As WorldDraw) As Boolean
        If keyword = "C" Then
            For i = 0 To ids.Length - 1
                ' 刷新画面.
                draw.Geometry.Draw(entCopy1(i))
            Next
        Else
            For k = 0 To few - 1
                For i = 0 To ids.Length - 1
                    ' 刷新画面.
                    draw.Geometry.Draw(entCopy(k, i))
                Next
            Next
        End If
        Return True
    End Function
    ' 将图形对象加入到模型空间的函数.
    Public Shared Function AppendEntity(ByVal ent As Entity) As ObjectId
        ' 得到当前文档图形数据库.
        Dim db As Database = HostApplicationServices.WorkingDatabase
        Dim entId As ObjectId
        Using trans As Transaction = db.TransactionManager.StartTransaction
            ' 以读方式打开块表.
            Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
            ' 以写方式打开模型空间块表记录.
            Dim btr As BlockTableRecord = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
            ' 将图形对象的信息添加到块表记录中,并返回ObjectId对象.
            entId = btr.AppendEntity(ent)
            ' 把图形对象添加到事务处理中.
            trans.AddNewlyCreatedDBObject(ent, True)
            ' 提交事务处理.
            trans.Commit()
        End Using
        Return entId
    End Function
End Class