Aqui serão colocados alguns Lisp`s para aplicação no Autocad
1- Rotina que altera o tamanho do texto do desenho
(defun c:tamedit()
(setvar "cmdecho" 0)
(setq texto(entget(car(entsel "\nSelecione o texto:"))))
(setq te1(cdr(assoc 40 texto)))
(setq te(rtos te1 2 2))
(setq op(cdr(assoc 0 texto)))
(if (= op "TEXT")
(progn
(setq DCL(load_dialog "tamedit.dcl"))
(new_dialog "tamedit" DCL)
(set_tile "texto" te)
(mode_tile "texto" 2)
(action_tile "accept" "(setq op 1)(done_dialog)")
(action_tile "cancel" "(setq op nil)(done_dialog)")
(action_tile "texto" "(setq tex $value)()")
(start_dialog)
(unload_dialog DCL)
(if (= op 1)
(progn
(setq tex(atof tex))
(setq ede(subst (cons 40 tex)(assoc 40 texto) texto))
(entmod ede)))
(setvar "cmdecho" 1)))
;;;;;;;;;
(if (= op "MTEXT")
(progn
(setq DCL(load_dialog "tamedit.dcl"))
(new_dialog "tamedit" DCL)
(set_tile "texto" te)
(mode_tile "texto" 2)
(action_tile "accept" "(setq op 1)(done_dialog)")
(action_tile "cancel" "(setq op nil)(done_dialog)")
(action_tile "texto" "(setq tex $value)()")
(start_dialog)
(unload_dialog DCL)
(if (= op 1)
(progn
(setq tex(atof tex))
(setq ede(subst (cons 40 tex)(assoc 40 texto) texto))
(entmod ede)))
(setvar "cmdecho" 1)))
)
2- Rotina para cálculo de área
(Defun c:ca()
(setq pt nil
t nil
txt nil
p nil)
(setq pt (getpoint "\n Entre com o ponto: "))
(command "boundary" pt "" )
(command "area" "e" "last")
(setq t (getvar "area"))
(command "erase" "last" "")
(setq t (rtos t 2 2))
(setq TXT (strcat t " m2"))
(setq p (getpoint "\n Marque o ponto do texto"))
(command "text" "j" "c" p "" "" txt "")
)
3- Rotina que cria um circulo com linha ao centro
;;;DIREITOS AUTORAIS =======================================
;;;Objetivo: Rotina para Criar circulos com linhas de Centro
;;;Desenvolvida por: Edivan de Lira
;;;Data da ultima atualização: 27/11/03
;;;Arquivos do programa: Circen.lsp
;;;Comando: Circen
;;;DISTRIBUIÇÃO LIVRE ======================================
(defun c:circen ()
(setvar "cmdecho" 0)
(setq old-osmode (getvar "osmode"))
(setvar "osmode" 0)
(initget)
(setq diametro (getreal "Diâmetro do circulo: "))
(setq centro (getpoint "Insira um ponto para o centro do círculo: "))
(command "circle" centro "d" diametro)
(setq raio (/ diametro 2))
(setq p1 (list (- (nth 0 centro) (+ (/ raio 2) raio)) (nth 1 centro) (nth 2 centro)))
(setq p2 (list (+ (nth 0 centro) (+ (/ raio 2) raio)) (nth 1 centro) (nth 2 centro)))
(setq p3 (list (nth 0 centro) (+ (nth 1 centro) (+ (/ raio 2) raio)) (nth 2 centro)))
(setq p4 (list (nth 0 centro) (- (nth 1 centro) (+ (/ raio 2) raio)) (nth 2 centro)))
(command "layer" "new" "Centro" "Color" "9" "Centro" "ltype" "Center" "Centro" "")
(command "clayer" "centro")
(command "line" p1 p2 "")
(command "line" p3 p4 "")
(command "clayer" "0")
(setvar "osmode" old-osmode)
(setvar "cmdecho" 1)
(princ)
)
4 - Rotina para Colocar as Coordenadas dis Pontos Desejados
;Esta Rotina é de livre distribuição,por favor não mude este cabeçalho
;para que desenvolvedores como eu possa continuar a distribuir livremente
;tppedro@uol.com.br
(PRINC
"\nChamada de Coordenadas - Por: Pedro Maia dos Santos Filho "
)
(PRINC "\nDigite NE e tecle para começar...")
(princ)
(DEFUN c:ne (/ var-r5 coratu osmatu pto pto1 ptx stx pty sty p2 p3 p4
;;;tamx tamy tam
) (SETVAR "CMDECHO" 0)
(IF (= (GETVAR "USERR5") 0.0)
(PROGN (INITGET 7)
(SETQ var-r5 (GETREAL "\n-> Entre com o valor de VAR-R5 : "))
(SETVAR "USERR5" var-r5)
)
(SETQ var-r5 (GETVAR "USERR5"))
)
(SETQ coratu (GETVAR "CECOLOR")
osmatu (GETVAR "OSMODE")
)
(WHILE (SETQ pto (GETPOINT "\n-> Selecione o ponto a cotar : "))
(IF (SETQ pto1 (GETPOINT pto "\n-> Selecione o ponto de chamada : "))
(PROGN (SETQ ptx (CAR pto)
stx (RTOS ptx 2 4)
pty (CADR pto)
sty (RTOS pty 2 4)
)
(IF (<= (CAR pto) (CAR pto1))
(SETQ p2 (LIST (+ (CAR pto1) (/ 28.0 var-r5))
(CADR pto1)
(CADDR pto1)
)
p3 (LIST (+ (CAR pto1) (/ 1.0 var-r5))
(+ (CADR pto1) (/ 1.0 var-r5))
(CADDR pto1)
)
p4 (LIST (+ (CAR pto1) (/ 1.0 var-r5))
(- (CADR pto1) (/ 3.0 var-r5))
(CADDR pto1)
)
)
(SETQ p2 (LIST (- (CAR pto1) (/ 28.0 var-r5))
(CADR pto1)
(CADDR pto1)
)
p3 (LIST (+ (CAR p2) (/ 1.0 var-r5))
(+ (CADR p2) (/ 1.0 var-r5))
(CADDR p2)
)
p4 (LIST (+ (CAR p2) (/ 1.0 var-r5))
(- (CADR p2) (/ 3.0 var-r5))
(CADDR p2)
)
)
)
;;; (SETQ tamx (STRLEN stx)
;;; tamy (STRLEN sty)
;;; )
;;; (IF (< tamx tamy)
;;; (SETQ tam tamy)
;;; (SETQ tam tamx)
;;; )
(SETQ tex (STRCAT "N=" sty)
;; (STR sty tam))
tey (STRCAT "E=" stx)
;; (STR stx tam))
)
(SETVAR "CECOLOR" "2")
(SETVAR "OSMODE" 0)
;;(COMMAND "TEXT" p3 (/ 2.03 var-r5) "90" tex)
(ENTMAKE (LIST (CONS 0 "TEXT")
(CONS 1 tex)
(CONS 10 p3)
(CONS 40 (/ 2.03 var-r5))
(CONS 50 0.0)
)
)
;;(COMMAND "TEXT" p4 (/ 2.03 var-r5) "90" tey)
(ENTMAKE (LIST (CONS 0 "TEXT")
(CONS 1 tey)
(CONS 10 p4)
(CONS 40 (/ 2.03 var-r5))
(CONS 50 0.0)
)
)
(COMMAND "_.PLINE" pto pto1 p2 "")
(SETVAR "CECOLOR" coratu)
(SETVAR "OSMODE" osmatu)
)
nil
)
nil
)
(PRINC "\n-> Encerrado...")
(PRINC)
)
