Lisp »Tips 'n Tricks
»Funzioni ricorsive in AutoLISP »1 | 2 | 3 | 4 | 5 | 6 | 7
FRT2
Frt2 è un Lisp che disegna un cubo di dimensione 2r centrato nel punto p1(x,y). La funzione ricorsiva permette di generare un frattale 3D.
L'algoritmo di base è il seguente:
star(int x, int y, int r)
{
if (r > 0)
{
star(x-r,y+r,r/2);
star(x+r,y+r,r/2);
star(x-r,y-r,r/2);
star(x+r,y-r,r/2);
box(x,y,r);
}
}
Da: "Algoritmi in C++", R. Sedgewick Ed. Addison-Wesley
;;;
;;; frt2.lsp - 10 Febbraio 2004
;;; (C) by Claudio Piccini
;;; http://www.cg-cad.com/
;;;
;;; Disegna un frattale 3D
;;;
(defun myerror (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(ripVar)
(princ)
)
(defun salVar ()
(setq orto (getvar "orthomode"))
(setq snapp (getvar "osmode"))
(setq snm (getvar "snapmode"))
(setq piano (getvar "clayer"))
(setq nomeDir (getvar "dwgprefix"))
)
(defun ripVar ()
(command "_redraw")
(setvar "cmdecho" 1)
(setvar "osmode" snapp)
(setvar "snapmode" snm)
(setvar "orthomode" orto)
(setvar "clayer" piano)
(setq *error* olderr)
(princ)
)
(defun star (x y r)
(if (> r 0)
(progn
(star (- x r)(+ y r)(/ r 2))
(star (+ x r)(+ y r)(/ r 2))
(star (- x r)(- y r)(/ r 2))
(star (+ x r)(- y r)(/ r 2))
(setq p1 (list x y 0))
(command "_polygon" 4 p1 "" r)
(setq ob1 (entlast))
(command "_extrude" ob1 "" r 0)
)
)
)
(defun c:frt2 (/ p1 x y r ss)
(setq olderr *error* *error* myerror)
(setvar "cmdecho" 0)
(salVar)
(command "osnap" "_non")
(setq ss nil)
(setq ss (ssadd)) ; crea una selezione vuota
(setq p1 (getpoint "\nClicca un punto:"))
(initget (+ 2 4))
(setq r (getint "\nRaggio del cubo (10): "))
(if (= r nil)
(setq r 10)
)
(setq x (car p1))
(setq y (cadr p1))
(star x y r)
(ripVar)
)
;;;eof
|
FRTK
FrtK disegna un cubo di dimensione casuale. La funzione ricorsiva permette di generare un frattale 3D.
La funzione casuale è al solito (rn). E' lo stesso lisp frt2.lsp con un rigo di codice cambiato (in blu nel sorgente).
;;;
;;; frtk.lsp - 10 Febbraio 2004
;;; (C) by Claudio Piccini
;;; http://www.cg-cad.com/
;;;
;;; Disegna un frattale casuale 3D
;;;
(defun myerror (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(ripVar)
(princ)
)
(defun salVar ()
(setq orto (getvar "orthomode"))
(setq snapp (getvar "osmode"))
(setq snm (getvar "snapmode"))
(setq piano (getvar "clayer"))
(setq nomeDir (getvar "dwgprefix"))
)
(defun ripVar ()
(command "_redraw")
(setvar "cmdecho" 1)
(setvar "osmode" snapp)
(setvar "snapmode" snm)
(setvar "orthomode" orto)
(setvar "clayer" piano)
(setq *error* olderr)
(princ)
)
;|
Random number generator, from 0.000 to 0.999
Grass.lsp (C)1994 by Watson Kilbourne
http://www.cg-cad.com/ttlisp17.htm
|;
(defun rn ()
(if (not sd)
(setq sd (getvar "DATE"))
)
(setq md 65536
mx 25173
nc 13849
sd (rem (+ (* mx sd) nc) md)
)
(setq nx (/ sd md))
)
(defun star (x y r)
(if (> r 0)
(progn
(star (- x r)(+ y r)(/ r 2))
(star (+ x r)(+ y r)(/ r 2))
(star (- x r)(- y r)(/ r 2))
(star (+ x r)(- y r)(/ r 2))
(setq p1 (list x y 0))
(command "_polygon" 4 "_e" p1 (list (+ (+ x (rn)) r) (+ (+ y (rn)) r)))
(setq ob1 (entlast))
(command "_extrude" ob1 "" r 0)
)
)
)
(defun c:frtk (/ p1 x y r ss)
(setq olderr *error* *error* myerror)
(setvar "cmdecho" 0)
(salVar)
(command "osnap" "_non")
(setq ss nil)
(setq ss (ssadd)) ; crea una selezione vuota
(setq p1 (getpoint "\nClicca un punto:"))
(initget (+ 2 4))
(setq r (getint "\nRaggio del quadrato (10): "))
(if (= r nil)
(setq r 10)
)
(setq x (car p1))
(setq y (cadr p1))
(star x y r)
(ripVar)
)
;;;eof
|
FRTK2
FrtK2 disegna poligoni 3D di dimensione casuale e con numero dei lati compreso fra 4 e 7.
;;;
;;; frtK2.lsp - 10 Febbraio 2004
;;; (C) by Claudio Piccini
;;; http://www.cg-cad.com/
;;;
;;; Disegna un insieme di poligoni casuali in 3D.
;;;
(defun myerror (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(ripVar)
(princ)
)
(defun salVar ()
(setq orto (getvar "orthomode"))
(setq snapp (getvar "osmode"))
(setq snm (getvar "snapmode"))
(setq piano (getvar "clayer"))
(setq nomeDir (getvar "dwgprefix"))
)
(defun ripVar ()
(command "_redraw")
(setvar "cmdecho" 1)
(setvar "osmode" snapp)
(setvar "snapmode" snm)
(setvar "orthomode" orto)
(setvar "clayer" piano)
(setq *error* olderr)
(princ)
)
;|
Random number generator, from 0.000 to 0.999
Grass.lsp (C)1994 by Watson Kilbourne
http://www.cg-cad.com/ttlisp17.htm
|;
(defun rn ()
(if (not sd)
(setq sd (getvar "DATE"))
)
(setq md 65536
mx 25173
nc 13849
sd (rem (+ (* mx sd) nc) md)
)
(setq nx (/ sd md))
)
(defun star (x y r)
(if (> r 0)
(progn
(star (- x r)(+ y r)(/ r 2))
(star (+ x r)(+ y r)(/ r 2))
(star (- x r)(- y r)(/ r 2))
(star (+ x r)(- y r)(/ r 2))
(setq p1 (list x y 0))
(cond
((<= (rn) 0.3)(setq lati 4))
((<= (rn) 0.5)(setq lati 5))
((<= (rn) 0.7)(setq lati 6))
((<= (rn) 0.9)(setq lati 7))
)
(command "_polygon" lati "_e" p1 (list (+ (+ x (rn)) 1) (+ (+ y (rn)) 1)))
(setq ob1 (entlast))
(command "_extrude" ob1 "" r 0)
)
)
)
(defun c:frtk2 (/ p1 x y r ss)
(setq olderr *error* *error* myerror)
(setvar "cmdecho" 0)
(salVar)
(command "osnap" "_non")
(setq ss nil)
(setq ss (ssadd)) ; crea una selezione vuota
(setq p1 (getpoint "\nClicca un punto:"))
(initget (+ 2 4))
(setq r (getint "\nMisura iniziale (10): "))
(if (= r nil)
(setq r 10)
)
(setq x (car p1))
(setq y (cadr p1))
(star x y r)
(ripVar)
)
;;;eof
|
FRTK3
FrtK3 disegna poligoni 3D di dimensione casuale, con numero dei lati compreso fra 4 e 7.
Cambia in modo casuale colore al layer (1=rosso, 2=giallo, 3=verde, 5=blu).
;;;
;;; frtK3.lsp - 10 Febbraio 2004
;;; (C) by Claudio Piccini
;;; http://www.cg-cad.com/
;;;
;;; Disegna un insieme di poligoni casuali in 3D.
;;;
(defun myerror (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(ripVar)
(princ)
)
(defun salVar ()
(setq orto (getvar "orthomode"))
(setq snapp (getvar "osmode"))
(setq snm (getvar "snapmode"))
(setq piano (getvar "clayer"))
(setq nomeDir (getvar "dwgprefix"))
)
(defun ripVar ()
(command "_redraw")
(setvar "cmdecho" 1)
(setvar "osmode" snapp)
(setvar "snapmode" snm)
(setvar "orthomode" orto)
(setvar "clayer" piano)
(setq *error* olderr)
(princ)
)
;|
Random number generator, from 0.000 to 0.999
Grass.lsp (C)1994 by Watson Kilbourne
http://www.cg-cad.com/ttlisp17.htm
|;
(defun rn ()
(if (not sd)
(setq sd (getvar "DATE"))
)
(setq md 65536
mx 25173
nc 13849
sd (rem (+ (* mx sd) nc) md)
)
(setq nx (/ sd md))
)
(defun star (x y r)
(if (> r 0)
(progn
(star (- x r)(+ y r)(/ r 2))
(star (+ x r)(+ y r)(/ r 2))
(star (- x r)(- y r)(/ r 2))
(star (+ x r)(- y r)(/ r 2))
(setq p1 (list x y 0))
(cond
((<= (rn) 0.3)(setq lati 4)(command "_color" 5))
((<= (rn) 0.5)(setq lati 5)(command "_color" 3))
((<= (rn) 0.7)(setq lati 6)(command "_color" 2))
((<= (rn) 0.9)(setq lati 7)(command "_color" 1))
)
(command "_polygon" lati "_e" p1 (list (+ (+ x (rn)) 1) (+ (+ y (rn)) 1)))
(setq ob1 (entlast))
(command "_extrude" ob1 "" r 0)
)
)
)
(defun c:frtk3 (/ p1 x y r ss)
(setq olderr *error* *error* myerror)
(setvar "cmdecho" 0)
(salVar)
(command "osnap" "_non")
(setq ss nil)
(setq ss (ssadd)) ; crea una selezione vuota
(setq p1 (getpoint "\nClicca un punto:"))
(initget (+ 2 4))
(setq r (getint "\nMisura iniziale (10): "))
(if (= r nil)
(setq r 10)
)
(setq x (car p1))
(setq y (cadr p1))
(star x y r)
(ripVar)
)
;;;eof
|
BW1
Bw1 disegna un frattale formato da cubetti colorati posti sul piano.
Attenzione a non esagerare con la misura iniziale r!
;;;
;;; bw1.lsp - 10 Febbraio 2004
;;; (C) by Claudio Piccini
;;; http://www.cg-cad.com/
;;;
;;; Disegna un frattale di cubetti colorati sul piano.
;;;
(defun myerror (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(ripVar)
(princ)
)
(defun salVar ()
(setq orto (getvar "orthomode"))
(setq snapp (getvar "osmode"))
(setq snm (getvar "snapmode"))
(setq piano (getvar "clayer"))
(setq nomeDir (getvar "dwgprefix"))
)
(defun ripVar ()
(command "_redraw")
(setvar "cmdecho" 1)
(setvar "osmode" snapp)
(setvar "snapmode" snm)
(setvar "orthomode" orto)
(setvar "clayer" piano)
(setq *error* olderr)
(princ)
)
;|
Random number generator, from 0.000 to 0.999
Grass.lsp (C)1994 by Watson Kilbourne
http://www.cg-cad.com/ttlisp17.htm
|;
(defun rn ()
(if (not sd)
(setq sd (getvar "DATE"))
)
(setq md 65536
mx 25173
nc 13849
sd (rem (+ (* mx sd) nc) md)
)
(setq nx (/ sd md))
)
(defun star (x y r)
(if (> r 0)
(progn
(star (- x r)(+ y r)(- r 1))
(star (+ x r)(+ y r)(- r 1))
(star (- x r)(- y r)(- r 1))
(star (+ x r)(- y r)(- r 1))
(setq p1 (list x y 0))
(cond
((<= (rn) 0.3)(command "_color" 5))
((<= (rn) 0.5)(command "_color" 3))
((<= (rn) 0.7)(command "_color" 2))
((<= (rn) 0.9)(command "_color" 1))
)
(command "_polygon" 4 p1 "" r)
(setq ob1 (entlast))
(command "_extrude" ob1 "" 1 0)
)
)
)
(defun c:bw1 (/ p1 x y r ss)
(setq olderr *error* *error* myerror)
(setvar "cmdecho" 0)
(salVar)
(command "osnap" "_non")
(setq ss nil)
(setq ss (ssadd))
(setq p1 (getpoint "\nClicca un punto:"))
(initget (+ 2 4))
(setq r (getint "\nMisura iniziale (5): "))
(if (= r nil)
(setq r 5)
)
(setq x (car p1))
(setq y (cadr p1))
(star x y r)
(ripVar)
)
;;;eof
|
BW2
Bw2 disegna un frattale nello spazio formato da cubetti colorati.
Attenzione a non esagerare con la misura iniziale r!
;;;
;;; bw2.lsp - 10 Febbraio 2004
;;; (C) by Claudio Piccini
;;; http://www.cg-cad.com/
;;;
;;; Disegna un frattale formato da cubetti nello spazio.
;;;
(defun myerror (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(ripVar)
(princ)
)
(defun salVar ()
(setq orto (getvar "orthomode"))
(setq snapp (getvar "osmode"))
(setq snm (getvar "snapmode"))
(setq piano (getvar "clayer"))
(setq nomeDir (getvar "dwgprefix"))
)
(defun ripVar ()
(command "_redraw")
(setvar "cmdecho" 1)
(setvar "osmode" snapp)
(setvar "snapmode" snm)
(setvar "orthomode" orto)
(setvar "clayer" piano)
(setq *error* olderr)
(princ)
)
;|
Random number generator, from 0.000 to 0.999
Grass.lsp (C)1994 by Watson Kilbourne
http://www.cg-cad.com/ttlisp17.htm
|;
(defun rn ()
(if (not sd)
(setq sd (getvar "DATE"))
)
(setq md 65536
mx 25173
nc 13849
sd (rem (+ (* mx sd) nc) md)
)
(setq nx (/ sd md))
)
(defun star (x y z r)
(if (> r 0)
(progn
(star (- x r)(+ y r)(+ z 2)(- r 1))
(star (+ x r)(+ y r)(- z 5)(- r 1))
(star (- x r)(- y r)(- z 2)(- r 1))
(star (+ x r)(- y r)(+ z 10)(- r 1))
(setq p1 (list x y z))
(cond
((<= (rn) 0.3)(command "_color" 5))
((<= (rn) 0.5)(command "_color" 3))
((<= (rn) 0.7)(command "_color" 2))
((<= (rn) 0.9)(command "_color" 1))
)
(command "_polygon" 4 p1 "" r)
(setq ob1 (entlast))
(command "_extrude" ob1 "" 1 0)
)
)
)
(defun c:bw2 (/ p1 x y z r ss)
(setq olderr *error* *error* myerror)
(setvar "cmdecho" 0)
(salVar)
(command "osnap" "_non")
(setq ss nil)
(setq ss (ssadd)) ; crea una selezione vuota
(setq p1 (getpoint "\nClicca un punto:"))
(initget (+ 2 4))
(setq r (getint "\nMisura iniziale (5): "))
(if (= r nil)
(setq r 5)
)
(setq x (car p1))
(setq y (cadr p1))
(setq z 0)
(star x y z r)
(ripVar)
)
;;;eof
|
BW3
E' una variazione sul tema di BW1.
Attenzione a non esagerare con la misura iniziale r!
;;;
;;; Bw3.lsp - 10 Febbraio 2004
;;; (C) by Claudio Piccini
;;; http://www.cg-cad.com/
;;;
;;; Disegna un frattale di cubetti colorati sul piano.
;;; (variazione sul tema di Bw1.lsp)
(defun myerror (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(ripVar)
(princ)
)
(defun salVar ()
(setq orto (getvar "orthomode"))
(setq snapp (getvar "osmode"))
(setq snm (getvar "snapmode"))
(setq piano (getvar "clayer"))
(setq nomeDir (getvar "dwgprefix"))
)
(defun ripVar ()
(command "_redraw")
(setvar "cmdecho" 1)
(setvar "osmode" snapp)
(setvar "snapmode" snm)
(setvar "orthomode" orto)
(setvar "clayer" piano)
(setq *error* olderr)
(princ)
)
;|
Random number generator, from 0.000 to 0.999
Grass.lsp (C)1994 by Watson Kilbourne
http://www.cg-cad.com/ttlisp17.htm
|;
(defun rn ()
(if (not sd)
(setq sd (getvar "DATE"))
)
(setq md 65536
mx 25173
nc 13849
sd (rem (+ (* mx sd) nc) md)
)
(setq nx (/ sd md))
)
(defun star (x y r)
(if (> r 0)
(progn
(star (- x r)(+ y r)(- r 1))
(star (+ x r)(+ y r)(- r 1))
(star (- x r)(- y r)(- r 1))
(star (+ x r)(- y r)(- r 1))
(setq p1 (list x y 0))
(cond
((<= (rn) 0.3)(command "_color" 5))
((<= (rn) 0.5)(command "_color" 3))
((<= (rn) 0.7)(command "_color" 2))
((<= (rn) 0.9)(command "_color" 1))
)
(if (<= (rn) 0.5)
(progn
(command "_polygon" 4 "_e" p1 (list (+ (+ x (rn)) r) (+ (+ y (rn)) r)))
(setq ob1 (entlast))
(command "_extrude" ob1 "" 1 0)
)
)
)
)
)
(defun c:bw3 (/ p1 x y r ss)
(setq olderr *error* *error* myerror)
(setvar "cmdecho" 0)
(salVar)
(command "osnap" "_non")
(setq ss nil)
(setq ss (ssadd))
(setq p1 (getpoint "\nClicca un punto:"))
(initget (+ 2 4))
(setq r (getint "\nMisura iniziale (5): "))
(if (= r nil)
(setq r 5)
)
(setq x (car p1))
(setq y (cadr p1))
(star x y r)
(ripVar)
)
;;;eof
|
Lisp »Tips 'n Tricks
Ultimo Aggiornamento_Last Update: 10 Febbraio 2004
|
