Esercizi
di AutoLisp
a cura di
Gaetano G. Perlongo
(1999)
Indice
La codesta
pagina è la raccolta degli esercizi di AutoLisp sviluppati dall'arch.
Tindaro Tarantello (docente di disegno assistito al calcolatore) -
presso l'Istituto Nazionale per la Formazione l'Addestramento e l'Orientamento
Professionale (INFAOP) di Palermo, durante l'anno formativo 1998/1999.
Esso vuole essere un'utile guida a tutti coloro che intendono acquisire
una buona padronanza alla personalizzazione del pacchetto AutoCad.
Devo i miei ringraziamenti a Giuseppe Buttafuoco, per avermi istruito
sull'universo del "World Wide Web".
Trappeto
(Palermo), 3 maggio 1999
Linea
passante per due punti
(defun linea (/ pnt1 pnt2)
(graphscr)
(setq pnt1 (getpoint "\n primo punto:"))
(setq pnt2 (getpoint "\n secondo punto:"))
(command "line" pnt1 pnt2 " ")
(princ)
)
Conversione gradi/radianti
(defun
gr ()
(setq grad (getreal "inserisci l'angolo:"))
(setq rad (* pi (/ grad 180.0)))
(princ "l'angolo è:")
(princ rad)
(princ)
)
Conversione radianti/gradi
(defun rg ()
(setq rad (getreal "inserisci l'angolo:"))
(setq grad (* 180.0 (/ rad pi)))
(princ "l'angolo è:")
(princ grad)
(princ)
)
Calcolo
dell'area del rettangolo
(defun ar ()
(setq b (getreal "inserisci la base:"))
(setq h (getreal "inserisci l'altezza:"))
(setq ar (* b h))
(princ "l'area del rettangolo è:")
(princ ar)
(princ)
)
Calcolo
del perimetro del rettangolo
(defun pr ()
(setq b (getreal "inserisci la base:"))
(setq h (getreal "inserisci l'altezza:"))
(setq pr (+ b b h h))
(princ "il perimetro del rettangolo è:")
(princ pr)
(princ)
)
Disegno
di un cerchio (dando centro e raggio)
(defun cerchio1 (/ pnt1 r)
(graphscr)
(prompt "disegnare il cerchio attraverso il centro e il raggio")
(setq pnt1 (getpoint "\n inserisci il centro:"))
(setq r (getreal "\n inserisci il valore del raggio:"))
(command "circle" pnt1 r " ")
(princ)
)
Impostazione
testo
(defun scrivi (/ pnt1 h ang txt)
(graphscr)
(prompt "inserimento testo")
(setq pnt1 (getpoint "\n inserisci il punto iniziale:"))
(setq h (getdist "\n inserisci l'altezza:" pnt1))
(setq ang (getorient "\n inserisci l'angolo:"))
(setq txt (getstring "\n inserisci testo:"))
(command "text" pnt1 h ang txt )
(princ)
)
Disegno
del rettangolo (prima versione)
(defun c:rettangolo (/ pnt1 pnt2 pnt3
pnt4 alfa base diag alt)
(setq pnt1 (getpoint "\n introduci il primo punto"))
(setq pnt3 (getcorner "\n introduci il terzo punto" pnt1))
(setq diag (distance pnt1 pnt3))
(setq alfa ( angle pnt1 pnt3))
(setq alt (* diag (sin alfa)))
(setq base (* diag (cos alfa)))
(setq pnt2 ( polar pnt1 0 base))
(setq pnt4 ( polar pnt1 (gr 90) alt))
(command "line" pnt1 pnt2 pnt3 pnt4 "c")
(princ)
)
(defun gr (grad)
(* pi (/ grad 180.0)))
Disegno
del rettangolo (seconda versione)
(DEFUN C:RETTL (/ P1 P2 P3 L1 L2 A)
(SETQ P1 (GETPOINT "INSERIRE IL PUNTO BASE:"))
(TERPRI)
(SETQ L1 (GETDIST P1 "INSERIRE LA BASE :"))
(TERPRI)
(SETQ L2 (GETDIST P1 "INSERIRE L'ALTEZZA :"))
(TERPRI)
(SETQ A (GETANGLE P1 "INSERIRE L'ANGOLO :"))
(TERPRI)
(SETQ A (RTOG A))
(COMMAND "UCS" "S" "MIOUCS")
(COMMAND "UCS" "O" P1)
(COMMAND "UCS" "Z" A)
(SETQ P2 (LIST L1 0 (LAST P1)))
(SETQ P3 (LIST 0 L2 (LAST P1)))
(COMMAND "RECTANGLE" P2 P3)
(COMMAND "UCS" "R" "MIOUCS")
(COMMAND "UCS" "D" "MIOUCS")
(PRINC)
)
(DEFUN RTOG (rad)
(/ (* rad 180.0) pi )
)
Disegno
del rettangolo (terza versione)
(defun c:ret (/ base alt pnt1 pnt2 pnt3
pnt4)
(graphscr)
(setq pnt1 (getpoint "\n inserisci il primo punto:"))
(setq base (getdist "\n inserisci il valore della base:"))
(setq alt (getdist "\n inserisci l'altezza:"))
(setq pnt2 (polar pnt1 0 base))
(setq pnt3 (polar pnt2 (gr 90) alt))
(setq pnt4 (polar pnt1 (gr 90) alt))
(command "line" pnt1 pnt2 pnt3 pnt4 "c")
(princ)
)
Disegno
di due linee parallele
(defun c:parall (/ pnt1 pnt2 pnt3 pnt4
dist alfa lung)
(setq pnt1 (getpoint "\n inserisci il punto della base:"))
(setq dist (getdist "\n inserisci la distanza:"))
(setq lung (getdist "\n inserisci la lunghezza:"))
(setq alfa (getorient "\n inserisci l'angolo:" pnt1))
(setq pnt2 (polar pnt1 alfa lung))
(setq pnt3 (polar pnt2 (+ (gr 90) alfa) dist))
(setq pnt4 (polar pnt1 (+ (gr 90) alfa) dist))
(command "line" pnt1 pnt2 "")
(command "line" pnt3 pnt4 "")
(princ)
)
Disegno
del rettangolo (quarta versione)
(defun rtog (rad)
(/ (* rad 180.0) pi)
)
(defun c:rettl1 (/ p1 p2 p3 l1 l2 a ec os)
; Conserva il valore attuale della variabile
; di sistema CMDECHO
(setq ec (getvar "CMDECHO"))
; Conserva il valore attuale della variabile
; di sistema OSMODE (Modo osnap)
(setq os (getvar "OSMODE"))
; Imposta il valore di CMDECHO a 0
(setvar "CMDECHO" 0)
; Imposta il valore di OSMODE a 3 (end+mid)
(setvar "OSMODE" 3)
; Impedisce di rispondere con solo "INVIO"
(initget 1)
(SETQ P1 (GETPOINT "INSERIRE IL PUNTO BASE:"))
(TERPRI)
(initget 1)
(SETQ L1 (GETDIST P1 "INSERIRE LA BASE :"))
(TERPRI)
(initget 1)
(SETQ L2 (GETDIST P1 "INSERIRE L'ALTEZZA :"))
(TERPRI)
(initget 1)
(SETQ A (GETANGLE P1 "INSERIRE L'ANGOLO :"))
(TERPRI)
(SETQ A (RTOG A))
; Cancella preventivamente un eventuale ucs
; con il nome MIOUCS
(Command "UCS" "D" "MIOUCS")
(COMMAND "UCS" "S" "MIOUCS")
(COMMAND "UCS" "O" P1)
(COMMAND "UCS" "Z" A)
(SETQ P2 (LIST L1 0 (LAST P1)))
(SETQ P3 (LIST 0 L2 (LAST P1)))
(COMMAND "RECTANGLE" P2 P3)
(COMMAND "UCS" "R" "MIOUCS")
(COMMAND "UCS" "D" "MIOUCS")
; Ripristina il valore di CMDECHO
(setvar "CMDECHO" ec)
; Ripristina il valore di OSMODE
(setvar "OSMODE" os)
(PRINC)
)
Variabili
di tipo stringa (prima versione)
(defun c:Gaetano1 (/ nome cognome
datamese dataoggi nominativo annonasc annoggi lung anni)
; Inserimento dati
(setq nome (getstring "inserisci nome:" 20))
(setq cognome (getstring "inserisci cognome:" 20))
(setq datanasc (getstring "inserisci la data di nascita gg/mm/aa:"
8))
(setq dataoggi (getstring " inserisci la data di oggi gg/mm/aa:"
8))
; Manipolazione stringhe
(setq nominativo (strcat nome " " cognome))
(setq lung (strlen nominativo))
(setq annonasc (substr datanasc 7 2))
(setq annoggi (substr dataoggi 7 2))
(setq annonasc (atoi annonasc))
(setq annoggi (atoi annoggi))
(setq anni (- annoggi annonasc))
; Stampa riultati
(princ "nome e cognome:")
(terpri)
(princ nominativo)
(terpri)
(princ "anni:")
(terpri)
(princ anni)
(terpri)
(princ "lung:")
(terpri)
(princ lung)
(princ)
)
Variabili
di tipo stringa (seconda versione)
(defun c:Gaetano2 (/ nome cognome
datamese dataoggi nominativo annonasc annoggi lung anni)
; Inserimento dati
(setq nome (getstring "inserisci nome:" 20))
(setq cognome (getstring "inserisci cognome:" 20))
(setq datanasc (getstring "inserisci la data di nascita
gg/mm/anno:" 10))
(setq dataoggi (getstring " inserisci la data di oggi gg/mm/anno:"
10))
; Manipolazione stringhe
(setq nominativo (strcat nome " " cognome))
(setq lung (strlen nominativo))
(setq annonasc (substr datanasc 7 4))
(setq annoggi (substr dataoggi 7 4))
(setq annonasc (atoi annonasc))
(setq annoggi (atoi annoggi))
(setq anni (- annoggi annonasc))
; Stampa riultati
(princ "nome e cognome:")
(terpri)
(princ nominativo)
(terpri)
(princ "anni:")
(terpri)
(princ anni)
(terpri)
(princ "lung:")
(terpri)
(princ lung)
(princ)
)
Funzione
Type
(defun c:var ( / n1 n2 p1 s1 )
(setq n1 (getint "\n inserisci un numero intero:"))
(setq n2 (getreal "\n inserisci un numero reale:"))
(setq p1 (getpoint "\n inserisci un punto:"))
(setq s1 (getstring "\n inserisci una stringa:"))
;Stampa contenuto
(princ "\n_______________\n")
(princ (type n1)) (princ " ") (princ n1) (terpri)
(princ (type n2)) (princ " ") (princ n2) (terpri)
(princ (type p1)) (princ " ") (princ p1) (terpri)
(princ (type s1)) (princ " ") (princ s1) (terpri)
(princ "\n_______________\n")
(princ)
)
Funzione
Initget/Getkword
(defun c:var1 ( / n1 n2 p1 s1 )
(initget 3)
(initget 4)
(initget 1)
(setq n1 (getint "\n inserisci un numero intero:"))
(setq n2 (getreal "\n inserisci un numero reale:"))
(setq p1 (getpoint "\n inserisci un punto:"))
(initget 1 "S N s n")
(setq s1 (getkword "\n Uscita dal programma (S/N)?:"))
;Stampa contenuto
(princ "\n_______________\n")
(princ (type n1)) (princ " ") (princ n1) (terpri)
(princ (type n2)) (princ " ") (princ n2) (terpri)
(princ (type p1)) (princ " ") (princ p1) (terpri)
(princ "\n_______________\n")
(princ)
)
Funzione
Lista
(defun c:lista (/ li lr ls ll lm)
;Costruzione lista
(setq li (list 1 2 3 4))
(setq lr (list 8.5 7.0 3.1))
(setq ls (list "anna" "marco" "pino"))
(setq ll (list (list 78 24) (list "ciao" "addio")))
(setq lm (list 8.4 "marco" (list 2 4 8 10)))
;Scrittura lista
(princ "\n lista dei numeri interi:") (princ li)
(princ "\n lista dei numeri reali:") (princ lr)
(princ "\n lista di stringhe:") (princ ls)
(princ "\n lista mista:") (princ lm)
(princ)
)
Funzione
di Estrazione (prima versione)
(defun c:estrai (/ l1 n1 n2)
(setq l1 (list 10 20 (list 100 200) 4 5))
(setq n1 (car l1))
(setq n2 (cdr l1))
(princ "\n valore n1:")
(princ n1)
(princ "\n valore restante:")
(princ)
)
Funzione
di Estrazione (seconda versione)
(defun c:estraiz1 (/ l1 n1 n2 n3 n4)
(setq l1 (list 10 20 30 40 50))
(setq n1 (car l1))
(setq n2 (cadr l1))
(setq n3 (caddr l1))
(setq n4 (cadddr l1))
;Stampa valori
(princ "\n primo valore:") (princ n1)
(terpri)
(princ "\n secondo valore:") (princ n2)
(princ)
)
Funzione
di Estrazione (terza versione)
(defun c:estraiz2 (/ l1 n1 n2 n3 n4)
(setq l1 (list 10 20 30 40 50))
(setq n1 (car l1))
(setq n2 (car (cdr l1)))
(setq n3 (car (cdr (cdr l1))))
(setq n4 (car (cdr (cdr l1))))
;Stampa valori
(princ "\n primo valore:") (princ n1)
(terpri)
(princ "\n secondo valore:") (princ n2)
(princ)
)
Funzione
di Estrazione (quarta versione)
(defun c:extr (/ lista atom1 atom2 atom3
atom5 k1 k2)
(initget 1 "k")
(setq k1 (getkword "\n Per accedere al programma digitare k:"))
(setq lista (list "Piero" "Pino" 20 2.3 "si
amano"))
(setq atom1 (nth 0 lista))
(setq atom2 (nth 2 lista))
(setq atom3 (nth 2 lista))
(setq atom5 (nth 4 lista))
;Scrittura caratteri
(initget 1 "P p")
(setq k2 (getkword "\n per stampare p:"))
(princ atom1) (terpri)
(princ atom2) (terpri)
(princ atom3) (terpri)
(princ atom5) (terpri)
(princ)
)
Disegno
del rettangolo con l'uso delle liste (prima versione)
(defun c:rettlist1 (/ pnt1 pnt2 pnt3 pnt4)
(graphscr)
(setq pnt1 (getpoint "\n inserire il primo punto:"))
(setq pnt2 (getcorner "\n inserire il secondo punto:" pnt1))
(setq x3 (car pnt1))
(setq y3 (cadr pnt2))
(setq x4 (car pnt2))
(setq y4 (cadr pnt1))
(setq pnt3 (list x3 y3))
(setq pnt4 (list x4 y4))
(command "line" pnt1 pnt4 pnt2 pnt3 "c")
(princ)
)
Disegno
del rettangolo con l'uso delle liste (seconda versione)
(defun c:rettlist2 (/ pnt1 pnt2 pnt3 pnt4)
(graphscr)
(setq pnt1 (getpoint "\n inserire il primo punto:"))
(setq pnt2 (getcorner "\n inserire il secondo punto:" pnt1))
(setq pnt3 (list (car pnt1) (cadr pnt2)))
(setq pnt4 (list (car pnt2) (cadr pnt1)))
(command "line" pnt1 pnt4 pnt2 pnt3 "c")
(princ)
)
Istruzione IF (prova 1)
(defun c:esempio1 (/ n1)
(if ( n1 10)
(princ "\n Il valore è maggiore di 10")
(princ "\n Il valore non soddisfa")
) (princ)
)
Istruzione IF (prova 2)
(defun c:esempio2 (/ n1)
(setq n1 (getreal "Introduci il raggio del cerchio:"))
(if ( n1 10)
(progn
(princ "\n raggio ok")
(princ "\n Il raggio è di 10")
)
(progn
(princ "\n Attenzione, errore:")
(princ "\n Il raggio è
))
(princ)
)
Operatori booleani
(defun c:bool (/ coeff n1)
(setq n1 (getint "\n inserisci il valore:"))
(if (
(setq coeff 5))
(if (and ( n1 1000) (<= n1 5000))
(setq coeff 10))
(if (and ( n1 5000) (<= n1 20000))
(setq coeff 100))
(if (
(setq coeff 200))
(princ coeff)
(princ)
)
Funzione COND (prima versione)
(defun c:con (/ n1)
(setq n1 (getreal "inserisci un numero:"))
(cond ((<= n1 1000) (setq coeff 5))
((<= n1 5000) (setq coeff 10))
((<= n1 20000) (setq coeff 100))
(T (setq coeff 200))
)
(princ "\n coeff è:") (princ coeff)
(princ)
)
Funzione COND (seconda versione)
(defun c:infisso (/ Tasto Tipo)
(textscr)
(initget 1 "P F")
(setq Tasto (getkword "Porte/Finestre"))
(if (= Tasto "P"))
(progn
(initget 1 "P1 P2 P3")
(setq Tipo (getkword "\n P1/P2/P3 \n"))
(cond (=Tipo "P1")(princ "\n porta 1 anta")
(=Tipo "P2")(princ "\n porta 2 ante")
(=Tipo "P3")(princ "\n porta scorrevole")
)
;fine dell'istruzione cond
(command "insert" Tipo))
(command "insert" "F1")
(princ)
)
Estrazione da un blocco
(defun c:infissi(/ tasto tipo)
(textscr)
(initget 1 "P F")
(setq tasto (getkword "\n Porte/Finestre: "))
(if (eq tasto "P")
(progn
(initget 1 "porta80 porta90 porta2ante")
(setq tipo (getkword "\n porta80 porta90 porta2ante \n"))
(cond
(eq tipo "porta80")(princ "\n porta80 ")
(eq tipo "porta90")(princ "\n porta90 ")
(eq tipo "porta2ante")(princ "\n porta2ante")
)
(command "insert" tipo)
)
(command "insert" "finestra")
)
(princ)
)
Funzione Repeat
(defun c:cerchi1 ( / N R pnt1)
(setq N (getint "\n Quanti cerchi vuoi inserire:"))
(setq R (getreal "\n raggio:"))
(graphscr)
(repeat N
(setq pnt1 (getpoint "\n centro:"))
(command "circle" pnt1 R)
)
(princ)
)
Funzione Repeat con contatore
(defun c:cerchi2 ( / N R pnt1 K)
(setq N (getint "\n Quanti cerchi vuoi inserire:"))
(setq R (getreal "\n raggio:"))
(setq K 1)
(graphscr)
(repeat N
(princ "\n cerchio n:") (princ K)
(setq pnt1 (getpoint "\n centro:"))
(command "circle" pnt1 R)
(setq K (+ K 1))
)
(princ)
)
Bibliografia
- AA.VV.,
Manuale di personalizzazione di AutoCad release 13, Autodesk
Development B.V., Neuchatel (Svizzera), 1994;
- Agosto,
M., AutoLisp, tecniche nuove, Milano, 1993;
- Rusty,
G., Smith, J., AutoLisp: Tecniche di programmazione, Jackson
Libri, Milano, 1993.
Home
|