A 
Crie uma pasta para os arquivos .lsp que deseja utilizar.
Abra um arquivo novo no Notepad.exe do Windows ou no Visual Lisp do AutoCAD©.
Copie o conteúdo de cada painel e cole neste arquivo.
Salve o arquivo preferencialmente com o nome do comando criado:
Exemplo : para o comando C:PAO do painel 1, o nome do arquivo deveria ser PAO.LSP (exclua o C:)

1 


;;	=======================================================
;;	http://www.gr-acad.com.br
;;	Conheça o Memo-New, em desenvolvimento:
;;		===============================================
;;		http://www.gr-acad.com.br/Memo-New/memo-new.htm
;;		===============================================
;;	Escrito para Everton Rocha, lisp-livre, em 04/09/2001
;;	=======================================================

Objetivo : escrever números de quadra e lote, alem da área e perímetro deste último, de
           forma contínua...

(DEFUN c:pao (/ p1 nq hf are per lot ent pli dxf obj lotes)
  (SETVAR "CMDECHO" 0)
  (VL-LOAD-COM)
  (IF (AND (SETQ nq (GETINT "\n-> Informe o número da quadra : ")) (> nq 0))
    (WHILE (AND (SETQ lot (GETINT "\n-> Informe o número do lote : ")) (> lot 0))
      (IF (AND (SETQ pli (CAR (ENTSEL   ;
                                (STRCAT "\n-> Selecione a poligonal fechada do lote " ;
                                        (ITOA lot)
                                        " : "
                                )
                              )
                         )
               )
               (WCMATCH (CDR (ASSOC 0 (SETQ dxf (ENTGET pli)))) "*POLYLINE")
               (MEMBER (CDR (ASSOC 70 dxf)) '(1 129))
               (NOT (MEMBER lot lotes))
          )
        (PROGN (SETQ obj (VLAX-ENAME->VLA-OBJECT pli)
                     are (VLAX-GET-PROPERTY obj 'area)
                     per (VLAX-GET-PROPERTY obj 'LENGTH)
               )
               (IF (NOT hf)
                 (PROGN (INITGET 7) (SETQ hf (GETREAL "\n-> Informe a altura da fonte : ")))
               )
               (INITGET 1)
               (SETQ p1 (GETPOINT "\n-> Ponto de inserção do texto informativo : "))
               (ENTMAKE (LIST (CONS 0 "TEXT")
                              (CONS 1 (STRCAT "Quadra " (ITOA nq))) ;
                              (CONS 10 p1)
                              (CONS 40 hf)
                              (CONS 50 0.0)
                        )
               )
               (ENTMAKE (LIST (CONS 0 "TEXT")
                              (CONS 1 (STRCAT "Lote " (ITOA lot)))
                              (CONS 10 (LIST (CAR p1) (- (CADR p1) (* 1.5 hf)) (CADDR p1)))
                              (CONS 40 hf)
                              (CONS 50 0.0)
                        )
               )
               (ENTMAKE (LIST (CONS 0 "TEXT")
                              (CONS 1 (STRCAT "Área = " (RTOS are 2 3) " m²"))
                              (CONS 10 (LIST (CAR p1) (- (CADR p1) hf hf hf) (CADDR p1)))
                              (CONS 40 hf)
                              (CONS 50 0.0)
                        )
               )
               (ENTMAKE (LIST (CONS 0 "TEXT")
                              (CONS 1 (STRCAT "Perímetro = " (RTOS per 2 3) " m"))
                              (CONS 10 (LIST (CAR p1) (- (CADR p1) (* 4.5 hf)) (CADDR p1)))
                              (CONS 40 hf)
                              (CONS 50 0.0)
                        )
               )
               (SETQ lotes (APPEND lotes (LIST lot)))
        )
        (IF (MEMBER lot lotes)
          (ALERT (STRCAT "Erro:\n\n\t"  ;
                         "Este lote já foi processado. Informe outro número..."
                 )
          )
          (ALERT (STRCAT "Atenção:\n\n\t"
                         "Entidade recusada. Sòmente polilinhas fechadas podem\n\t"
                         "ser utilizadas nesta rotina..."
                 )
          )
        )
      )
    )
    (PRINC "\n-> Número da quadra não foi informado...")
  )
  (PRINC)
)


2 


;;        Em lisp-livre@..., marcus vinicius oliveira lima <topografialima@...> escreveu
;;        
;;        Por favor, alguém pode me auxiliar ajustando esta rotina para que retorne na  
;;        tela o resultado com 3 casas decimais.
;;        Quando ela faz a operação de somar ou subtrair um certo valor de um texto com 
;;        um valor numérico ela retorna com duas casas e preciso com 3.
;;        Caso alguém possa me ajudar agradeço desde já.
;;        Sds
;;        Marcus Lima
;;                                                                  Rotina original aqui
;;        ==============================================================================
;;                                                   Nova versão da rotina do link acima
;;        ==============================================================================

(DEFUN c:aum (/ conjunto altura nent ent tipo cotatxt cotac cota aumenta chequea troca
                dimzin
             )
  (DEFUN aumenta (/ nova)
    (SETQ nova (RTOS (+ cota altura) 2 3))
    (SETQ ent (SUBST (CONS 1 nova) (ASSOC 1 ent) ent))
    (ENTMOD ent)
  )
  (DEFUN chequea (cotatxt / n i letra sem_zero com_zero)
    (SETQ n (STRLEN cotatxt))
    (SETQ i 0)
    (REPEAT n
      (SETQ i (1+ i))
      (SETQ letra (SUBSTR cotatxt i 1))
      (IF (AND (/= letra "0") (/= letra "-") (/= letra ".") (/= letra ",") (/= letra " "))
        (SETQ sem_zero T)
      )
      (IF (= letra "0")
        (SETQ com_zero T)
      )
    )
    (IF (NOT com_zero)
      (SETQ sem_zero T)
    )
    (SETQ sem_zero sem_zero)
  )
  (DEFUN troca (cota l1 l2 / n i letra cota)
    (SETQ n (STRLEN cota))
    (SETQ i 0)
    (REPEAT (1- n)
      (SETQ i (1+ i))
      (SETQ letra (SUBSTR cota i 1))
      (IF (= letra l2)
        (SETQ cota (STRCAT (SUBSTR cota 1 (1- i)) l1 (SUBSTR cota (1+ i) (- n i))))
      )
    )
    (SETQ cota cota)
  )
  (PROMPT "\n-> Selecione o texto a modificar : ")
  (IF (SETQ conjunto
             (SSGET '((0 . "TEXT") (-4 . "<OR") (1 . "#*") (1 . "-#*") (-4 . "OR>")))
      )
    (PROGN (INITGET 1)
           (SETQ altura (GETREAL "\n-> Informe o valor a somar a este(s) texto(s) : "))
           (SETQ nent   -1
                 dimzin (GETVAR "DIMZIN")
           )
           (SETVAR "DIMZIN" 0)
           (REPEAT (SSLENGTH conjunto)
             (SETQ nent    (1+ nent)
                   ent     (ENTGET (SSNAME conjunto nent))
                   tipo    (CDR (ASSOC 0 ent))
                   cotatxt (CDR (ASSOC 1 ent))
                   cotac   (troca cotatxt "." ",")
                   cota    (ATOF cotac)
             )
             (IF (OR (/= cota 0.0) (NOT (chequea cotatxt)))
               (aumenta)
             )
           )
           (SETVAR "DIMZIN" dimzin)
    )
    (PRINC "\n-> Textos não selecionados...")
  )
  (PRIN1)
)
(PRINC "\n-> Rotina carregada, digite AUM e tecle ENTER para rodar...")
(PRINC)

;;        Copie o trecho acima para um arquivo e salve-o com o nome AUM.LSP
;;        Faça backup de seu arquivo original.
;;        e.fernal


3 


;;; Escrito por Eduardo Fernal em 25/07/2005
;;; http://www.gr-acad.com.br
;;; Todos os direitos autorais reservados...
;;; Pode ser livremente usada desde que mantidos estes créditos...
;;; *****************************************************************************
;;; Esta rotina solicita a seleção de um círculo (de forma contínua) e, se
;;; esta seleção for válida, coloca textos informativos com o raio, o comprimento
;;; e a área de cada círculo selecionado...
;;; Desenvolvida a pedidos...
;;; *****************************************************************************
;;; *****************************************************************************

(DEFUN c:lcir (/ ent p10 p11 raio perimetro hfonte dimzin)
  (SETVAR "CMDECHO" 0)
  (IF (NOT g::hfonte::luciana)
    ;; Se não houver...
    (SETQ g::hfonte::luciana 12.5)
    ;; cria uma variavel numérica de escopo global!
  )
  ;; Abaixo, solicita a altura da fonte
  (SETQ hfonte (GETREAL (STRCAT "\n-> Altura do texto < "
                                (RTOS g::hfonte::luciana 2 3)
                                " > : "
                        )
               )
  )
  ;; Se a altura não for fornecida ou se for inválida...
  (IF (OR (NOT hfonte)
          (NOT (NUMBERP hfonte))
          (ZEROP hfonte)
          (MINUSP hfonte)
      )
    ;; então assume o valor da variável global...
    (SETQ hfonte g::hfonte::luciana)
  )
  ;; Agora atualiza o valor da variável global com o valor da variável local
  (SETQ dimzin (GETVAR "DIMZIN"))
  (SETVAR "DIMZIN" 8)
  ;; Ajusta dimzin para evitar zeros à direita dos valores numéricos...
  (SETQ g::hfonte::luciana hfonte)
  (WHILE (SETQ ent (CAR (ENTSEL "\n-> Selecione círculo a medir : ")))
    (IF (= (CDR (ASSOC 0 (ENTGET ent))) "CIRCLE")
                                        ; Verifica se é circulo
      (PROGN (SETQ ent       (ENTGET ent)
                   raio      (CDR (ASSOC 40 ent))
                                        ; Extrai o valor do raio
                   p10       (CDR (ASSOC 10 ent))
                                        ; Extrai o ponto central
                   p11       (POLAR p10 (* PI 0.25) (* 2. raio))
                                        ; Calcula um ponto externo
                   perimetro (* 2.0 PI raio)
                                        ; Calcula o comprimento do círculo
             )
             ;; Abaixo, desenha uma linha como 'leader'
             (ENTMAKE (LIST (CONS 0 "LINE")
                            (CONS 10 (POLAR p10 (* PI 0.25) raio))
                            (CONS 11 p11)
                      )
             )
             ;; Abaixo, coloca um texto com o valor do raio
             (ENTMAKE (LIST (CONS 0 "TEXT")
                            (CONS 1 (STRCAT "R=" (RTOS raio 2 4)))
                                        ; Texto com valor do raio
                            (CONS 10 p11)
                            (CONS 40 hfonte)
                                        ; hfonte é a altura do texto
                            (CONS 50 0.0)
                                        ; O ângulo do texto (em radianos)
                      )
             )
             ;; Abaixo, coloca um texto com o valor do comprimento
             (ENTMAKE
               (LIST (CONS 0 "TEXT")
                     (CONS 1 (STRCAT "L=" (RTOS perimetro 2 4)))
                                        ; Texto com valor do raio
                     (CONS 10 (POLAR p11 (* PI 1.5) (* hfonte 1.5)))
                     (CONS 40 hfonte)   ; hfonte é a altura do texto
                     (CONS 50 0.0)      ; O ângulo do texto (em radianos)
               )
             )
             ;; Abaixo, coloca um texto com o valor da área
             (ENTMAKE
               (LIST (CONS 0 "TEXT")
                     (CONS 1 (STRCAT "S=" (RTOS (* PI raio raio) 2 4)))
                                        ; Texto com valor do raio
                     (CONS 10 (POLAR p11 (* PI 1.5) (* hfonte 3.0)))
                     (CONS 40 hfonte)   ; hfonte é a altura do texto
                     (CONS 50 0.0)      ; O ângulo do texto (em radianos)
               )
             )
      )
      (ALERT "Erro:\n\n\tEsta entidade não é círculo!\t\n\n")
      ;; Se a entidade selecionada não for um círculo, então avisa o operador...
    )
  )
  (SETVAR "DIMZIN" dimzin)
  ;; Restabelece dimzin ao seu valor anterior...
  (PRINC)
)
(PRINC "\n-> Digite LCIR e tecle ENTER para rodar...")
(PRINC)




4 




;;; Rotina criada em 29/07/2005 por Eduardo Fernal, a pedidos
;;; ************************************************************************
;;; 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)
;;; ************************************************************************
;|
Caros
Estou a procura de uma Lisp para inserção de Blocos,
caso tenha e puder disponibilizar.
Seria o seguinte :
Ex. Tenho um bloco chamado casa.
Qdo for inserir o bloco casa, apenas digitaria casa.

Antecipadamente agradeço
MH
___________________________________________________________________________________

Bem, faremos um código que criará dois comandos.
O primeiro para solicitar o nome do bloco, pois agora é 'casa' e depois poderia
ser 'carro'. Assim, a rotina principal solicitaria o 'nome' do bloco (não pode ter
espaço) e criaria então uma rotina com este nome, para inserir o bloco. Como blocos
podem ter ou não atributos, a sua atualização será desligada na inserção, mas o
comando ddatte será acionado em seguida, se estes existirem... Observe:
|;

(DEFUN c:mh ;| substitua por seu nome, se quiser...|;
       (/ nome_do_bloco)
  (IF (AND (SETQ nome_do_bloco
                  (GETSTRING
                    "\n-> Entre com o nome do bloco para criar o comando : "
                  )
           )
           (> (STRLEN nome_do_bloco) 0)
           (TBLSEARCH "BLOCK" nome_do_bloco)
      )
    (PROGN
      (EVAL
        (READ
          (STRCAT
            "(DEFUN c:"
            nome_do_bloco
            " (/ p1 attreq attdia)(SETQ attreq (GETVAR "
            (CHR 34)
            "ATTREQ"
            (CHR 34)
            ") attdia (GETVAR "
            (CHR 34)
            "ATTDIA"
            (CHR 34)
            "))(SETVAR "
            (CHR 34)
            "ATTREQ"
            (CHR 34)
            " 0)(SETVAR "
            (CHR 34)
            "ATTDIA"
            (CHR 34)
            " 1)(IF (SETQ p1 (GETPOINT (STRCAT "
            (CHR 34)
            "\\n-> Ponto de inserção de "
            (CHR 34)
            (CHR 34)
            nome_do_bloco
            (CHR 34)
            (CHR 34)
            " : "
            (CHR 34)
            ")))(PROGN(COMMAND "
            (CHR 34)
            "_.-INSERT"
            (CHR 34)
            (CHR 34)
            nome_do_bloco
            (CHR 34)
            (CHR 34)
            "_NON"
            (CHR 34)
            " p1 1 1 pause)"
            "(IF (CDR (ASSOC 66 (ENTGET (ENTLAST))))(COMMAND "
            (CHR 34)
            "DDATTE"
            (CHR 34)
            " (ENTLAST)))))(SETVAR "
            (CHR 34)
            "ATTDIA"
            (CHR 34)
            " attdia)(SETVAR "
            (CHR 34)
            "ATTREQ"
            (CHR 34)
            " attreq)(PRINC))"
          )
        )
      )
      (ALERT (STRCAT "Atenção:\n\n\tCriado o comando\n\t"
                     (STRCASE nome_do_bloco)
                     "\n\tpara inserção deste bloco!"
             )
      )
    )
    (ALERT
      "Erro:\n\n\tNome inválido ou bloco com este nome não existe!"
    )
  )
  (PRINC)
)
(PRINC "\n-> Digite MH e tecle ENTER para rodar...")
(PRINC)


5 


;;; 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 units)
  (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")
        units   (GETVAR "INSUNITS")
  )
  (SETVAR "ATTREQ" 1)
  (SETVAR "INSUNITS" 0)
  ;; Enquanto fornecer pontos, o bloco (se criado com sucesso) será inserido!
  (WHILE (SETQ p1 (GETPOINT
                    "\n-> Ponto para inserção do bloco de coordenadas ou ENTER para encerrar : "
                  )
         )
    ;; 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 3))
               (STRCAT "N=" (RTOS (CADR p1) 2 3))
               (STRCAT "Z=" (RTOS (CADDR p1) 2 3))
      )
      (ALERT
        "Atenção:\n\n\tErro na criação do bloco GR_ACAD_FREE_PCYZ"
      )
    )
  )
  (SETVAR "INSUNITS" units)
  (SETVAR "ATTREQ" attreq)
  (PRINC)
)
(PRINC "\n-> Digite CXYZ e tecle ENTER para rodar...")
(PRINC)


6 


;; Rotina escrita por Eduardo Fernal, em 10/01/2004
;; http://www.gr-acad.com.br
;; Conheça o Curso E.Fernal de Autolisp em CD

(DEFUN c:ctx (/ sn cn s1 tx p1 p2 an pa pb pc pd d1 li ap bp cp dp hf clayer)
  (PROMPT "\n-> Selecione textos para a criação de caixas envolventes : ")
  (IF (SETQ s1 (SSGET '((0 . "TEXT"))))
    (PROGN (SETQ sn	(SSLENGTH s1)
		 cn	0
		 clayer	(GETVAR "CLAYER")
	   )
	   (COMMAND "_.UNDO" "_BEGIN")
	   (IF (NULL (TBLSEARCH "LAYER" "Caixa_em_textos"))
	     (ENTMAKEX '((0 . "LAYER")
			 (100 . "AcDbSymbolTableRecord")
			 (100 . "AcDbLayerTableRecord")
			 (2 . "Caixa_em_textos")
			 (70 . 0)
			 (62 . 254)
			 (6 . "Continuous")
			 (290 . 1)
			 (370 . -3)
			)
	     )
	   )
	   (SETVAR "CLAYER" "Caixa_em_textos")
	   (REPEAT sn
	     (SETQ li (TEXTBOX (SETQ tx (ENTGET (SSNAME s1 cn))))
		   cn (1+ cn)
		   p1 (CAR li)
		   p2 (CADR li)
		   an (ANGLE p1 p2)
		   hf (CDR (ASSOC 40 tx))
		   d1 (DISTANCE p1 p2)
		   pa (CDR (ASSOC 10 tx))
		   pc (POLAR pa (+ an (CDR (ASSOC 50 tx))) d1)
		   pd (POLAR pa
			     (+	(CDR (ASSOC 50 tx)) 
				(* PI 0.5)
			     )		
			     (- (CADR p2) (CADR p1))
		      )
		   pb (POLAR pa (CDR (ASSOC 50 tx)) (DISTANCE pd pc))
		   pa (POLAR pa (ANGLE pb pa) hf)
		   pb (POLAR pb (ANGLE pa pb) hf)
		   pd (POLAR pd (ANGLE pc pd) hf)
		   pc (POLAR pc (ANGLE pd pc) hf)
		   pa (POLAR pa (ANGLE pd pa) hf)
		   pb (POLAR pb (ANGLE pc pb) hf)
		   pd (POLAR pd (ANGLE pa pd) hf)
		   pc (POLAR pc (ANGLE pb pc) hf)
	     )
	     (COMMAND "_.PLINE" "_NON" pa "_NON" pb "_NON" pc "_NON" pd "_CLOSE")
	   )
	   (SETVAR "CLAYER" clayer)
	   (COMMAND "_.UNDO" "_END")
    )
    (PRINC "\n-> Textos não selecionados...")
  )
  (PRINC)
)
(PRINC "\n-> Digite CTX e tecle enter para executar")
(PRINC)


7