Curso Online de AutoLISP© - Desenvolvido e ministrado por Eduardo Fernal, arquiteto
Conheça mais em http://www.gr-acad.com.br
Parceria :  http://www.cadklein.com

;;; Rotina criada em 29/07/2005 por Eduardo Fernal
;;; *************************************************************************
;;; Pode ser usada livremente, desde que mantidos estes créditos
;;; Conheça outras rotinas e aplicativos para AutoCAD e IntelliCAD
;;; no site http://www.gr-acad.com.br
;;; Aprenda a programar em AutoLISP com o Curso E.Fernal de Autolisp (em cd)
;;; *************************************************************************
;;; *************************************************************************
;;; Esta rotina solicita a seleção de pontos e insere as coordenadas x,y,z em
;;; com um bloco atributado. O bloco, se não existir, será criada antes, pela
;;; propria rotina. Esta parte do código não faz parte da rotina, para
;;; economizar memória (isto é, ela é executada e não fica na memória...)
;;; *************************************************************************
;;; Vamos garantir a existência da rotina GR_ACAD_FREE_PCYZ.lsp que cria o
;;; bloco necessário para esta rotina. Ela será escrita na pasta de Acad.exe
;;; *************************************************************************
;;; *************************************************************************
(IF (NOT (FINDFILE "GR_ACAD_FREE_PCYZ.lsp"))
  (PROGN (SETQ lista '(DEFUN
                       c_cria_pxy
                       (/ lista arq)
                       (IF
                        (NULL
                         (TBLSEARCH
                          "BLOCK"       
                          "GR_ACAD_FREE_PCYZ"
                         )
                        )
                        (PROGN
                         (IF
                          (NULL
                           (TBLSEARCH
                            "STYLE"     
                            "VERDANA"
                           )
                          )
                          (ENTMAKEX
                           '((0 . "STYLE")
                             (100 . "AcDbSymbolTableRecord")
                             (100 . "AcDbTextStyleTableRecord")
                             (2 . "Verdana")
                             (70 . 0)
                             (40 . 0.0)
                             (41 . 1.0)
                             (50 . 0.0)
                             (71 . 0)
                             (42 . 2.5)
                             (3 . "VERDANA.TTF")
                             (4 . "")
                            )
                          )
                         )
                         ;; cria o estilo de texto VERDANA para os atributos...
                         ;; Agora cria o bloco
                         (ENTMAKE
                          '((0 . "BLOCK")
                            (2 . "GR_ACAD_FREE_PCYZ")
                            (70 . 2)
                            (10 0.0 0.0 0.0)
                           )
                         )
                         (ENTMAKE
                          '((0 . "LINE")
                            (100 . "AcDbEntity")
                            (67 . 0)
                            (8 . "0")
                            (100 . "AcDbLine")
                            (10 141.667 -8.33333 0.0)
                            (11 16.6667 -8.33333 0.0)
                            (210 0.0 0.0 1.0)
                           )
                         )
                         (ENTMAKE
                          '((0 . "LINE")
                            (100 . "AcDbEntity")
                            (67 . 0)
                            (8 . "0")
                            (100 . "AcDbLine")
                            (10 141.667 8.33333 0.0)
                            (11 16.6667 8.33333 0.0)
                            (210 0.0 0.0 1.0)
                           )
                         )
                         (ENTMAKE
                          '((0 . "LWPOLYLINE")
                            (100 . "AcDbEntity")
                            (67 . 0)
                            (8 . "0")
                            (100 . "AcDbPolyline")
                            (90 . 4)
                            (70 . 1)
                            (43 . 0.0)
                            (38 . 0.0)
                            (39 . 0.0)
                            (10 16.6667 25.0)
                            (40 . 0.0)
                            (41 . 0.0)
                            (42 . 0.0)
                            (10 141.667 25.0)
                            (40 . 0.0)
                            (41 . 0.0)
                            (42 . 0.0)
                            (10 141.667 -25.0)
                            (40 . 0.0)
                            (41 . 0.0)
                            (42 . 0.0)
                            (10 16.6667 -25.0)
                            (40 . 0.0)
                            (41 . 0.0)
                            (42 . 0.0)
                            (210 0.0 0.0 1.0)
                           )
                         )
                         (ENTMAKE
                          '((0 . "LINE")
                            (100 . "AcDbEntity")
                            (67 . 0)
                            (8 . "0")
                            (100 . "AcDbLine")
                            (10 8.33333 0.0 0.0)
                            (11 -8.33333 0.0 0.0)
                            (210 0.0 0.0 1.0)
                           )
                         )
                         (ENTMAKE
                          '((0 . "LINE")
                            (100 . "AcDbEntity")
                            (67 . 0)
                            (8 . "0")
                            (100 . "AcDbLine")
                            (10 0.0 -8.33333 0.0)
                            (11 0.0 8.33333 0.0)
                            (210 0.0 0.0 1.0)
                           )
                         )
                         (ENTMAKE
                          '((0 . "CIRCLE")
                            (100 . "AcDbEntity")
                            (67 . 0)
                            (8 . "0")
                            (100 . "AcDbCircle")
                            (10 0.0 0.0 0.0)
                            (40 . 5.0)
                            (210 0.0 0.0 1.0)
                           )
                         )
                         (ENTMAKE
                          '((0 . "ATTDEF")
                            (100 . "AcDbEntity")
                            (67 . 0)
                            (8 . "0")
                            (100 . "AcDbText")
                            (10 21.6667 10.0 0.0)
                            (40 . 10.0)
                            (1 . "0")
                            (50 . 0.0)
                            (41 . 1.0)
                            (51 . 0.0)
                            (7 . "Verdana")
                            (71 . 0)
                            (72 . 0)
                            (11 0.0 0.0 0.0)
                            (210 0.0 0.0 1.0)
                            (100 . "AcDbAttributeDefinition")
                            (3 . "X")
                            (2 . "1")
                            (70 . 0)
                            (73 . 0)
                            (74 . 0)
                           )
                         )
                         (ENTMAKE
                          '((0 . "ATTDEF")
                            (100 . "AcDbEntity")
                            (67 . 0)
                            (8 . "0")
                            (100 . "AcDbText")
                            (10 21.6667 -5.0 0.0)
                            (40 . 10.0)
                            (1 . "0")
                            (50 . 0.0)
                            (41 . 1.0)
                            (51 . 0.0)
                            (7 . "Verdana")
                            (71 . 0)
                            (72 . 0)
                            (11 0.0 0.0 0.0)
                            (210 0.0 0.0 1.0)
                            (100 . "AcDbAttributeDefinition")
                            (3 . "Y")
                            (2 . "2")
                            (70 . 0)
                            (73 . 0)
                            (74 . 0)
                           )
                         )
                         (ENTMAKE
                          '((0 . "ATTDEF")
                            (100 . "AcDbEntity")
                            (67 . 0)
                            (8 . "0")
                            (100 . "AcDbText")
                            (10 21.6667 -20.0 0.0)
                            (40 . 10.0)
                            (1 . "0")
                            (50 . 0.0)
                            (41 . 1.0)
                            (51 . 0.0)
                            (7 . "Verdana")
                            (71 . 0)
                            (72 . 0)
                            (11 0.0 0.0 0.0)
                            (210 0.0 0.0 1.0)
                            (100 . "AcDbAttributeDefinition")
                            (3 . "Z")
                            (2 . "3")
                            (70 . 0)
                            (73 . 0)
                            (74 . 0)
                           )
                         )
                         (ENTMAKE '((0 . "ENDBLK")))
                        )
                       )
                       (PRINC)
                      )
         )
         (SETQ arq (FINDFILE "acad.exe")
               arq (STRCAT (SUBSTR arq 1 (- (STRLEN arq) 8))
                           "GR_ACAD_FREE_PCYZ.lsp"
                   )
               arq (OPEN arq "w")
         )
         (PRINT lista arq)
         (CLOSE arq)
         (SETQ lista nil)
  )
  nil
)
;;; ***************************************************************************
;;; Pronto. A rotina geradora do bloco está feita. Agora vamos definir a rotina
;;; principal, que usará esta rotina, caso o bloco não esteja presente...
;;; ***************************************************************************
(DEFUN c:cxyz (/ p1 x y z unidade c_cria_pxy attreq)
  (INITGET "Milímetros Centímetros MEtros" 1)
  (SETQ unidade
         (GETKWORD
           "\n-> Informe a unidade de trabalho < Milímetros Centímetros MEtros > : "
         )
  )
  ;; Define a unidade de trabalho...
  (SETQ unidade (COND ((NOT unidade) 1.0)
                      ((= unidade "Milimetros") 10.0)
                      ((= unidade "Centímetros") 1.0)
                      ((= unidade "MEtros") 0.01)
                      (T
                )
        attreq  (GETVAR "ATTREQ")
  )
  (SETVAR "ATTREQ" 1)
  ;; Enquanto fornecer pontos, o bloco (se criado com sucesso) será inserido!
  (WHILE (SETQ p1 (GETPOINT
                    "\n-> Ponto para inserção do bloco de coordenadas : "
                  )
         )
    ;; Garantimos a existência do bloco aqui...
    (IF (NULL (TBLSEARCH "BLOCK"        
                         "GR_ACAD_FREE_PCYZ"
              )
        )
      (PROGN (LOAD "GR_ACAD_FREE_PCYZ" 0)
             (IF c_cria_pxy
               (c_cria_pxy)
               nil
             )
             (SETQ c_cria_pxy nil)
      )
    )
    ;; Bloco existe? Então inserimos o mesmo em 'p1'
    (IF (TBLSEARCH "BLOCK"              
                   "GR_ACAD_FREE_PCYZ"
        )
      (COMMAND "_.INSERT"
               "GR_ACAD_FREE_PCYZ"
               "_NON"
               p1
               unidade
               unidade
               0.0
               (STRCAT "E=" (RTOS (CAR p1) 2 2))
               (STRCAT "N=" (RTOS (CADR p1) 2 2))
               (STRCAT "Z=" (RTOS (CADDR p1) 2 2))
      )
      (ALERT
        "Atenção:\n\n\tErro na criação do bloco GR_ACAD_FREE_PCYZ\t\n\n"
      )
    )
  )
  (SETVAR "ATTREQ" attreq)
  (PRINC)
)
(PRINC "\n-> Digite CXYZ e tecle ENTER para rodar...")
(PRINC)

Fim deste arquivo...