动态拖拽圆角 -

程序代码：

Imports System
Imports System.Text
Imports System.Linq
Imports System.Xml
Imports System.Reflection
Imports System.ComponentModel
Imports System.Collections
Imports System.Collections.Generic

Imports System.IO

Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Windows

Imports MgdAcApplication = Autodesk.AutoCAD.ApplicationServices.Application
Imports MgdAcDocument = Autodesk.AutoCAD.ApplicationServices.Document
Imports AcWindowsNS = Autodesk.AutoCAD.Windows


Namespace AcadNetAddinWizard_Namespace
    Public Class FilletJigger
        Inherits EntityJig
        'region Fields

        Public mCurJigFactorIndex As Integer = 1

        Private mBasePoint As New Point3d()
        Private mNewPoint As Point3d
        ' Factor #1
        Public mOriginalVertices As Point2dCollection

        'endregion

        'region Constructors

        Public Sub New(ByVal ent As Entity, ByVal basePoint As Point3d)
            MyBase.New(ent)
            mOriginalVertices = New Point2dCollection()
            Dim i As Integer = 0
            While i < PLine.NumberOfVertices
                mOriginalVertices.Add(PLine.GetPoint2dAt(i))
                System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
            End While

            mNewPoint = basePoint.TransformBy(UCS)
            mBasePoint = basePoint.TransformBy(UCS)
        End Sub

        'endregion

        'egion Properties

        Private ReadOnly Property Editor() As Editor
            Get
                Return MgdAcApplication.DocumentManager.MdiActiveDocument.Editor
            End Get
        End Property

        Private ReadOnly Property UCS() As Matrix3d
            Get
                Return Editor.CurrentUserCoordinateSystem
            End Get
        End Property

        Private ReadOnly Property PLine() As Polyline
            Get
                Return TryCast(Entity, Polyline)
            End Get
        End Property

        'endregion

        'region Overrides

        Protected Overrides Function Update() As Boolean
            Dim dist As Double = mBasePoint.DistanceTo(mNewPoint)
            Dim ptCol As New Point2dCollection()
            Dim i As Integer = 0
            While i < mOriginalVertices.Count
                Dim current As Point2d = mOriginalVertices(i)
                Dim previous As Point2d = If(i = 0, mOriginalVertices(mOriginalVertices.Count - 1), mOriginalVertices(i - 1))
                Dim [next] As Point2d = If(i = mOriginalVertices.Count - 1, mOriginalVertices(0), mOriginalVertices(i + 1))

                Dim pt1 As Point2d = current + (previous - current) / current.GetDistanceTo(previous) * dist
                Dim pt2 As Point2d = current + ([next] - current) / current.GetDistanceTo([next]) * dist
                ptCol.Add(pt1)
                ptCol.Add(pt2)
                System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
            End While

            Dim j As Integer = 0
            While j < PLine.NumberOfVertices
                PLine.SetPointAt(j, ptCol(j))
                System.Math.Max(System.Threading.Interlocked.Increment(j), j - 1)
            End While
            Dim m As Integer = PLine.NumberOfVertices
            While m < ptCol.Count
                PLine.AddVertexAt(m, ptCol(m), 0, 0, 0)
                System.Math.Max(System.Threading.Interlocked.Increment(m), m - 1)
            End While

            Return True
        End Function

        Protected Overrides Function Sampler(ByVal prompts As JigPrompts) As SamplerStatus
            Select Case mCurJigFactorIndex
                Case 1
                    Dim prOptions1 As New JigPromptPointOptions(vbLf & "Location:")
                    prOptions1.UserInputControls = UserInputControls.Accept3dCoordinates Or UserInputControls.GovernedByOrthoMode Or UserInputControls.GovernedByUCSDetect
                    prOptions1.BasePoint = mBasePoint
                    prOptions1.UseBasePoint = True
                    Dim prResult1 As PromptPointResult = prompts.AcquirePoint(prOptions1)

                    If prResult1.Status = PromptStatus.Cancel Then
                        Return SamplerStatus.Cancel
                    End If

                    If prResult1.Value.Equals(mNewPoint) Then
                        'Use better comparision method if wanted.
                        Return SamplerStatus.NoChange
                    Else
                        mNewPoint = prResult1.Value
                        Return SamplerStatus.OK
                    End If
                Case Else
                    Exit Select
            End Select

            Return SamplerStatus.OK
        End Function

        'endregion

        'region Methods to Call

        Public Shared jigger As FilletJigger = Nothing
        Public Shared Function Jig(ByVal ent As Entity, ByVal basePt As Point3d) As Boolean
            Try
                jigger = New FilletJigger(ent, basePt)
                Dim pr As PromptResult
                Do
                    pr = MgdAcApplication.DocumentManager.MdiActiveDocument.Editor.Drag(jigger)
                    ' Add keyword handling code below

                    If pr.Status = PromptStatus.Keyword Then
                    Else
                        System.Math.Max(System.Threading.Interlocked.Increment(jigger.mCurJigFactorIndex), jigger.mCurJigFactorIndex - 1)
                    End If
                Loop While pr.Status <> PromptStatus.Cancel AndAlso pr.Status <> PromptStatus.[Error] AndAlso jigger.mCurJigFactorIndex <= 1

                If pr.Status = PromptStatus.Cancel OrElse pr.Status = PromptStatus.[Error] Then
                    If jigger IsNot Nothing AndAlso jigger.Entity IsNot Nothing Then
                        jigger.Entity.Dispose()
                    End If

                    Return False
                Else
                    Return True
                End If
            Catch
                If jigger IsNot Nothing AndAlso jigger.Entity IsNot Nothing Then
                    jigger.Entity.Dispose()
                End If

                Return False
            End Try
        End Function
        'endregion

        'region Test Commands

        <CommandMethod("TestFilletJigger")> _
        Public Shared Sub TestFilletJigger_Method()
            Dim ed As Editor = MgdAcApplication.DocumentManager.MdiActiveDocument.Editor
            Dim db As Database = HostApplicationServices.WorkingDatabase
            Try
                Dim selRes As PromptEntityResult = ed.GetEntity(vbLf & "Pick a polygon to fillet:")
                If selRes.Status = PromptStatus.OK Then
                    Using tr As Transaction = db.TransactionManager.StartTransaction()
                        Dim ent As Entity = TryCast(tr.GetObject(selRes.ObjectId, OpenMode.ForWrite), Entity)
                        If ent IsNot Nothing AndAlso TypeOf ent Is Polyline AndAlso (CType(ent, Polyline)).Closed Then
                            If FilletJigger.Jig(ent, selRes.PickedPoint) Then
                                tr.Commit()
                            Else
                                tr.Abort()
                            End If
                        End If
                    End Using
                End If
            Catch ex As System.Exception
                ed.WriteMessage(ex.ToString())
            End Try
        End Sub
        'endregion
    End Class
End Namespace