Retangulos e vb.net

‘importa as dependencias

Imports Autodesk.AutoCAD.DatabaseServices

Imports Autodesk.AutoCAD.Runtime

Imports Autodesk.AutoCAD.Geometry

Imports Autodesk.AutoCAD.ApplicationServices

Imports Autodesk.AutoCAD.EditorInput

 

Public Class TestEntityJig

 

    ‘classe que faz o prompt do terceiro ponto, strechando o retângulo:

    Private Class GetPoint2Jig

        ‘herda estas caracteristicas:

        Inherits EntityJig

 

        ‘variaveis globais desta classe:

        Private pta, ptb, ptc As Point3d ‘pontos que formam o retângulo

        Private msg As String

 

        Public Sub New(ByVal pt1 As Point3d, ByVal pt2 As Point3d, ByVal message As String)

            ‘cria uma pline virtual:

            MyBase.New(New Polyline(4))

            With DirectCast(Entity, Polyline)

                .AddVertexAt(0, New Point2d(pt1.X, pt1.Y), 0, 0, 0)

                .AddVertexAt(0, New Point2d(pt2.X, pt2.Y), 0, 0, 0)

                .AddVertexAt(0, New Point2d(pt2.X, pt2.Y), 0, 0, 0)

                .AddVertexAt(0, New Point2d(pt1.X, pt1.Y), 0, 0, 0)

                .Closed = True

            End With

            ‘inicializa as variaveis globais

            msg = message

            pta = pt1

            ptb = pt2

 

        End Sub

 

        ‘função que atualiza a variavel PTC, que é usada para redesenhar o retângulo

        Protected Overrides Function Sampler(ByVal prompts As JigPrompts) As SamplerStatus

            Dim jigOpts As New JigPromptPointOptions(msg)

            jigOpts.UserInputControls = UserInputControls.Accept3dCoordinates

 

            Dim dres As PromptPointResult = prompts.AcquirePoint(jigOpts)

            ptc = dres.Value

 

            If dres.Status = PromptStatus.Cancel Then

                Return SamplerStatus.Cancel

            Else

                Return SamplerStatus.OK

            End If

        End Function

 

        ‘função que atualizao retângulo

        Protected Overrides Function Update() As Boolean

            ‘angulo do vetor BA

            Dim ang_ab As Double = Math.Atan2(ptb.Y – pta.Y, ptb.X – pta.X)

 

            ‘angulo interno dos vetores AB e AC

            Dim ang_abc As Double = Math.Atan2(ptc.Y – pta.Y, ptc.X – pta.X) – ang_ab

 

            ‘distancia do ponto A ao B

            Dim d_ab As Double = pta.DistanceTo(ptc) * Math.Sin(ang_abc)

 

            ‘angulo perpendicular ao vetor AB

            Dim ang_ac = ang_ab + Math.PI / 2

 

            ‘delta das coordenadas (nao achei uma função polar…):

            Dim dx As Double = d_ab * Math.Cos(ang_ac)

            Dim dy As Double = d_ab * Math.Sin(ang_ac)

 

            ‘atualiza o retangulo

            Try

                With DirectCast(Entity, Polyline)

                    .SetPointAt(2, New Point2d(ptb.X + dx, ptb.Y + dy))

                    .SetPointAt(3, New Point2d(pta.X + dx, pta.Y + dy))

                End With

            Catch generatedExceptionName As System.Exception

                Return False

            End Try

            Return True

 

        End Function

 

        ‘função que devolve a polilinha virtual

        Public Function Get_Entity() As Polyline

            Return DirectCast(Entity, Polyline)

        End Function

    End Class

 

    ‘comando a ser usado na linha de comando:

    <CommandMethod(“ret”)> _

    Public Shared Sub ret()

        Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor

 

        ‘pede o primeiro ponto

        Dim res1 As PromptPointResult = ed.GetPoint(vbLf & “Ponto 1:”)

        If res1.Status <> PromptStatus.OK Then Exit Sub

 

        ‘pede o segundo ponto

        Dim opts As New PromptPointOptions(vbLf & “Ponto 2:”)

        opts.BasePoint = res1.Value

        opts.UseBasePoint = True

        Dim res2 As PromptPointResult = ed.GetPoint(opts)

        If res2.Status <> PromptStatus.OK Then Exit Sub

 

        ‘pede o terceiro ponto, modificando o retangulo

        ‘conforme o mouse mexe:

        Dim jig As New GetPoint2Jig(res1.Value, res2.Value, vbLf & “Ponto 3”)

        Dim res As PromptResult = ed.Drag(jig)

 

 

        If res.Status = PromptStatus.OK Then

            ‘tudo certo, adiciona a polilina ao modelspace:

            Dim pline As Polyline = jig.Get_Entity

            Dim db As Database = Application.DocumentManager.MdiActiveDocument.Database

            Dim tm As Autodesk.AutoCAD.DatabaseServices.TransactionManager = db.TransactionManager

            Dim ta As Transaction = tm.StartTransaction()

 

            Try

                Dim bt As BlockTable = tm.GetObject(db.BlockTableId, OpenMode.ForRead, False)

                Dim btr As BlockTableRecord = tm.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite, False)

                Dim lineid As ObjectId = btr.AppendEntity(pline)

                tm.AddNewlyCreatedDBObject(pline, True)

                ta.Commit()

            Finally

                ta.Dispose()

            End Try

 

        End If

    End Sub

End Class