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.

Polilinhas e suas áreas

Bom, postei essa lisp aí no site do autolisp e vou colocar ela aqui também:

---

(DEFUN C:AREA2 (/ ent pt polig model application thisdrawing Height) 
  (vl-load-com) 
  (setq ent    (car (Entsel "\nSelecione pline")) 
       pt     (getpoint "\nInforme o ponto de inserção") 
       Height (getdist "\nQual a altura do texto") 
       polig  (vlax-ename->vla-object ent) 
       application (vlax-get-acad-object) 
       thisdrawing (vla-get-activedocument application) 
       model (vla-get-modelspace thisdrawing) 
       TextString (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId " 
                        (itoa (vla-get-ObjectID polig)) 
                        ">%).Area \\f ""%lu2%pr2%ps[A=,m²]%ds44%th46"">%") 
       InsertionPoint (vlax-3d-point pt) 
        
       ) 
  (vla-addtext model TextString InsertionPoint Height) 
  )

---

Ela faz o seguinte: após selecionar uma polilinha, ela cria um texto contendo a área desta polilinha. Simples né? o interessante fica por conta do FIELD que ela usa para escrever este texto!!! pois ele se atualiza se você modificar esta polilinha!! Este é um recurso que já vem de tempos no autocad, mas que pouca gente usa ou mesmo conhece...

Vai ser bastante útil para quem faz desenho arquitetônico!!!

Com poucas modificações, dá pra fazer escrever esse texto numa tabela por exemplo, já que o mais complexo é criar a string correta para o FIELD... Aconselho a você se informar mais sobre FIELDs no menu "Insert/Filed" e no help do cad... tem coisas bem interessantes que dá pra fazer, hehehehe

CIVIL 3D 2009 - ATUALIZACAO

Saiu o service patch 2.1 do c3d 2009:
Ver
Leiame da coisa toda

106586Kb, puca coisa, não?


Me pergunto... com todos esperando o 2010, já que está saindo todo ano, por que eles ainda lançam estas atualizações?

AUTOLISP FORA DO AR

Parece que [mala]ELE[/mala] conseguiu:

Sinto ter responsabilidade nisso também, mas enquanto houver gente com tempo de sobra pra avacalhar a vida dos outros, é melhor que fique assim mesmo

C3DRENESG - ATUALIZAÇÃO 02-03-2009

Atualização do C3DRENESG, com diversas coisas novas!!!



não deixe de experimentar:
Download










14/10/2008
Adicionada comando para exportar a planilha de cálculo para HTML
Visualização dos coeficientes C (coef. de impermeabilidade), TC (tempo de concentração) da drenagem e Cini (contribuição inicial) do esgoto no "Structure Properties"
Colunas "movíveis" na planilha, sendo que é possível mostrar/esconder qualquer coluna
Ajuste automático pela planilha da cota da tampa das caixas de ligação
Possibilidade de mostrar/esconder linhas conforme tipo de estrutura a montante
Planilha pode ser copiada com um simples CTRL+C
Correção de looping infinito no cálculo da lâmina real

22/10/2008
Novo layout
Possibilidade de salvar os parâmetros
Possibilidade de exportar a planilha para HTML
Melhora do desempenho de cálculo
Melhora no marcador de colunas disponíveis

09/11/2008
E finalmente, um help para o programa:
Lançamento
Conhecendo a planilha
Parâmetros de cálculo

14/11/2008
Melhorada a validação da rede
Detalhamento de erros, com zoom nos elementos com problema
Proteção por hardlock
A versão full e demo são a mesma, escolha pelo hardlock
Implementação dos botões Desfaz/Refaz
Preview do perfil do trecho selecionado, com marcação do cobrimento ou profundidade máxima não satisfeito

25/11/2008
Marcação das células que compõe:
Soma das áreas de contribuição (drenagem)
Marcação da soma dos tempos da partícula mais demorada
Soma das extensões que compõe a extensão total
Reindexação do cálculo interno
Remoção de tabelas e variáveis desnecessárias

22/12/2008
Inclusão de um autoloader após a instalação

07/01/2009
Correção de bug ao salvar arquivo HTML da planilha, não eram listados os arquivos existentes
Duas novas colunas na planilha, que informam a Surface de refêrencia da estrutura de Montante e do tubo do trecho selecionado

22/01/2009
Correção de bug com os botões Desfazer/Refazer
Ao selecionar uma linha clicando no nome do(s) trecho(s), é executado o zoom neste(s) trecho(s)
Células da tabela de variáveis mudam a cor da fonte de letra caso um valor impróprio é atribuido
Prevenção contra valores não numéricos adicionada. Se um valor não numérico é digitado, a ação é desfeita
Prevenção contra o separador de decimais do windows, quando um valor é digitado, antes de atribuí-lo à variável correspondente, ele é formatado e reescrito na célula onde foi digitado, assim, valors impróprios podem ser controlados.
Tooltips nas colunas, mostrando seus significados

05/02/2009
Log de erros ao substituir pvs, indicando possíveis problemas
C3DRENAREA Não mais associa a mesma área de contribuição a duas estruturas diferentes
Implementado o comando C3DELAREA
Agora o preview mostra além do tubo da seleção atual e os erros de cobrimento, mostra também o tubo que sai e o(s) tubo(s) que chega(m), inclusive marcando-os quanto a sua declividade.

05/03/2009
Adição da ALA simétrica
Adição do comando C3DROTSTRUC
Alteração da maneira como é tratada a coluna "tubo/tampa"
Implementação do parâmetros VALA nos tubos do "Pipes Catalog" fornecido

não deixe de experimentar:
Download