'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
