Mais Fields - Nome do Layout

Que tal incluir um texto no carmbo da prancha, que contenha o nome do layout em que ele está? Legal né? Com Fields é fácil, veja:

---

(defun C:nlayout (/ thisdrawing paper pt alt utility)
;carrega as VLs
  (vl-load-com)

  (setq
;pega o documento atual:
    thisdrawing (vla-get-activedocument
          (vlax-get-acad-object))
;pega o layout:
    paper  (vla-get-paperspace thisdrawing)
;funções do tipo "get alguma" coisa:
    utility (vla-get-utility thisdrawing)
;pede a seleção de um texto:
    pt      (vla-getpoint
          utility
          nil
          "\nClique um ponto:")
    alt     (vla-getdistance
          utility
          nil
          "\nAltura do texto:"))

;cria um text no paper, com o nome do layout:
  (vla-addtext paper
    (strcat "%<\\AcObjProp Object(%<\\_ObjId "
        (itoa (vla-get-objectid
            (vla-get-layout paper)))
        ">%).Name \\f \"%tc1\">%")
    pt
    alt)
  (princ))

---

Assim, você pode numerar os layouts e ter certeza de que no carimbo estará certo o texto. Detalhe: se você usar depois o "Copy/Move" num layout ara criar a próxima página (se não faz assim, experimente clicar com o botão direito do mouse sobre a aba do layout atual e usar o Copy/Move), esta Field será atualizada para usar o nome da página correta!! E se renomear algum layout, a field se atualiza sozinha, muito legal, hehehe!!!

Para usar é simples, carrega a lisp com APPLOAD e digita NLAYOUT na linha de comando:

Como tabelar pontos

Esses tempos atráz, me pediram um programa que criasse uma tabela com as coordenadas dos pontos de um desenho... Bem aí está:

ver isso!!!

(vl-load-com)
(defun c:tabelar (/ ss NumRows InsertionPoint NumColumns RowHeight ColWidth
          model table nRow id ent vla)
  (setq ss             (ssget ":S" '((0 . "POINT")))
    NumRows        (sslength ss)
    InsertionPoint (vlax-3d-point 
                         (getpoint "\nEntre com um ponto"))
    NumColumns 3   ;nome, x, y -> 3
    RowHeight 2
    ColWidth 10
    model (vla-get-modelspace 
                (vla-get-activedocument (vlax-get-acad-object)))
    table (vla-addtable model InsertionPoint
        (1+ NumRows) ;uma linha pro titulo...
                     ;ou vai depender do estilo da tabela
        NumColumns RowHeight ColWidth)
    nRow 0)
  (repeat NumRows
    (setq ent (ssname ss nRow)
      vla (vlax-ename->vla-object ent)
      id  (vla-get-ObjectID vla)
      nRow (1+ nRow))
    
    ;escreve o nº do ponto na coluna 1
    (vla-Settextstring
      table ;a tabela em si
      nRow  ;linha
      0     ;coluna
      (* nRow 3) ;"id" da celula
      (itoa nRow) ;conteudo da celula
      )
    
    ;escreve o X na coluna 2:
    (vla-Setformula
      table ;a tabela em si
      nRow  ;linha
      1     ;coluna
      (+ 1 (* nRow 3)) ;"id" da celula
      (strcat ;cria uma "field" q mostra o X
    "%<\\AcObjProp Object(%<\\_ObjId "
    (itoa id)
    ">%).Coordinates \\f \"%pt1\">%"))
    
    ;escreve o Y na coluna 3:
    (vla-Setformula table nRow 2 (+ 2 (* nRow 3))
      (strcat ;cria uma "field" q mostra o Y
    "%<\\AcObjProp Object(%<\\_ObjId "
    (itoa id)
    ">%).Coordinates \\f \"%pt2\">%")))
  ;atualiza a tabela:
  (vla-GenerateLayout table))

Para usar é simples, carrega a lisp, desenha alguns pontos ( comando POINT ) e chama a lisp na linha de comando: TABELAR
Será pedido um ponto de inserção e será criada uma TABLE do autocad com as coordenadas X e Y desses pontos.

Bem bobinho este programa, eu sei, mas servirá de exemplo para quem quer saber como usar FIELD e desenhar TABLE com lisp.

Retangulos e vb.net

Que tal desenhar retângulos com VB.NET em qualquer ângulo?
Veja o programa abaixo:

mais...

'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

Com ele dá pra fazer isso:

Baixe o programa pronto aqui (autocad 2008 em diante, ok?), para usar, descompacte a dll em algum lugar, e use o comando NETLOAD para carregar a DLL, depois digite RET na linha de comando.