|
Lisp »Tips 'n Tricks
»Simmetrie »1 »2 »3 »4 »5 »6 »7
GLXY1
;|
GLXY1.LSP (C) 2005 by Claudio Piccini.
www.cg-cad.com
Disegna una galassia a spirale formata da un insieme di punti
disposti in modo casuale.
Traduzione in autolisp dell'algoritmo 'How to produce a galaxy'
in 'Computers, Pattern, Chaos and Beauty' di C.A. Pickover
2001, Dover Publications, Inc.
Pseudocode 12.3
in = curvature of galactic arm (try in=2)
maxit = maximum iteration number
scale = radial multiplicative scale factor
cut = radial cutoff
f = final scale factor
loop1: Do i = 0 to maxit
theta=float(i)/50;
r=scale*exp(theta*tan(in));
if r > cut then leave loop1;
x=r*cos(theta)+50;
y=r*sin(theta)+50;
call rand(randx); (* return a random number between 0-1 *)
call rand(randy); (* return a random number between 0-1 *)
PlotDotAt(x+f*randx,y+f*randy);
end;
loop2: Do i = 0 to maxit
theta=float(i)/50;
theta2=(float(i)/50)-3.14;
r=scale*exp(theta2*tan(in));
if r > cut then leave loop2;
x=r*cos(theta)+50;
y=r*sin(theta)+50;
call rand(randx);
call rand(randy);
PlotDotAt(x+f*randx,y+f*randy);
end;
|;
(defun galaxy ( / steps ; numero iterazioni
in ; curvatura
cut ; stop sviluppo spirale
theta i r x y
)
(initget (+ 2 4)) ; non 0, non negativo
(setq steps (getint "\nsteps? [1000] "))
(if (= steps nil)(setq steps 1000))
(initget (+ 2 4))
(setq in (getreal "\ncurvatura? [0.2] "))
(if (= in nil)(setq in 0.2))
(initget (+ 2 4))
(setq cut (getint "\ncut off? [50] "))
(if (= cut nil)(setq cut 50))
(setq i 0)
(while (<= i steps)
(setq theta (/ (* i 1.0) cut))
(setq r (exp (* theta (tan in))))
(if (> r cut)(setq i steps))
(setq x (* r (cos theta)))
(setq y (* r (sin theta)))
(command "_point" (list (+ (rn) x)(+ (rn) y)))
(setq i (1+ i))
)
(setq i 0)
(while (<= i steps)
(setq theta (/ (* i 1.0) cut))
(setq r (exp (* (+ theta pi)(tan in))))
(if (> r cut)(setq i steps))
(setq x (* r (cos theta)))
(setq y (* r (sin theta)))
(command "_point" (list (+ (rn) x)(+ (rn) y)))
(setq i (1+ i))
)
)
(defun tan (in)(/ (sin in)(cos in)))
;|
Genera un numero reale casuale compreso tra 0 e 7
Vedi il tutorial n.37 "Numeri casuali"
in AutoLISP Tips & Tricks Volume I
|;
(defun rn ( / m b c )
(if (not sd)(setq sd (getvar "DATE")))
(setq m 65521 b 15937 c 33503)
(setq sd (rem (+ (* b sd) c) m))
(* (/ sd m) 7)
)
(defun c:glxy1 ( / sd snapp )
(setvar "cmdecho" 0)
(setq snapp (getvar "osmode"))
(command "_osnap" "_non")
(galaxy)
(setvar "osmode" snapp)
(command "_redraw")
(setvar "cmdecho" 1)
(princ)
)
;;;eof
|
GLXY2
;|
GLXY2.LSP (C) 2005 by Claudio Piccini.
www.cg-cad.com
Disegna una galassia a spirale
Traduzione in autolisp dell'algoritmo 'How to produce a galaxy'
in 'Computers, Pattern, Chaos and Beauty' di C.A. Pickover
2001, Dover Publications, Inc.
|;
(defun galaxy ( / steps ; numero iterazioni
in ; curvatura
cut ; stop sviluppo spirale
numc ; limite sup. intervallo num. casuali
theta i r x y
)
(initget (+ 2 4)) ; non 0, non negativo
(setq steps (getint "\nsteps? [1000] "))
(if (= steps nil)(setq steps 1000))
(initget (+ 2 4))
(setq in (getreal "\ncurvatura? [0.2] "))
(if (= in nil)(setq in 0.2))
(initget (+ 2 4))
(setq cut (getint "\ncut off? [50] "))
(if (= cut nil)(setq cut 50))
(initget (+ 2 4))
(setq numc (getint "\nlimite sup. intervallo num. casuali 0-? [7]: "))
(if (= numc nil)(setq numc 7))
(setq i 0)
(while (<= i steps)
(setq theta (/ (* i 1.0) cut))
(setq r (exp (* theta (tan in))))
(if (> r cut)(setq i steps))
(setq x (* r (cos theta)))
(setq y (* r (sin theta)))
(command "_point" (list (+ (rn numc) x)(+ (rn numc) y)))
(setq i (1+ i))
)
(setq i 0)
(while (<= i steps)
(setq theta (/ (* i 1.0) cut))
(setq r (exp (* (+ theta pi)(tan in))))
(if (> r cut)(setq i steps))
(setq x (* r (cos theta)))
(setq y (* r (sin theta)))
(command "_point" (list (+ (rn numc) x)(+ (rn numc) y)))
(setq i (1+ i))
)
)
(defun tan (in)(/ (sin in)(cos in)))
;|
Genera un numero reale casuale compreso tra 0 e numc
Vedi il tutorial n.37 "Numeri casuali"
in AutoLISP Tips & Tricks Volume I
|;
(defun rn ( numc / m b c )
(if (not sd)(setq sd (getvar "DATE")))
(setq m 65521 b 15937 c 33503)
(setq sd (rem (+ (* b sd) c) m))
(* (/ sd m) numc)
)
(defun c:glxy2 ( / sd snapp )
(setvar "cmdecho" 0)
(setq snapp (getvar "osmode"))
(command "_osnap" "_non")
(galaxy)
(setvar "osmode" snapp)
(command "_redraw")
(setvar "cmdecho" 1)
(princ)
)
;;;eof
|
GLXY3
;|
GLXY3.LSP (C) 2005 by Claudio Piccini.
www.cg-cad.com
Disegna una galassia a spirale
Traduzione in autolisp dell'algoritmo 'How to produce a galaxy'
in 'Computers, Pattern, Chaos and Beauty' di C.A. Pickover
2001, Dover Publications, Inc.
|;
(defun galaxy ( / steps ; numero iterazioni
in ; curvatura
cut ; stop sviluppo spirale
numc ; limite sup. intervallo num. casuali
colore ; numero colore: 1-255
p0 ; centro della galassia
theta i r x y
)
(initget (+ 2 4)) ; non 0 non negativo
(setq steps (getint "\nsteps? [1000] "))
(if (= steps nil)(setq steps 1000))
(initget (+ 2 4))
(setq in (getreal "\ncurvatura? [0.2] "))
(if (= in nil)(setq in 0.2))
(initget (+ 2 4))
(setq cut (getint "\ncut off? [50] "))
(if (= cut nil)(setq cut 50))
(initget (+ 2 4))
(setq numc (getint "\nlimite sup. intervallo num. casuali 0-? [7]: "))
(if (= numc nil)(setq numc 7))
(setq p0 (getpoint "\nclicca un punto:"))
(setq i 0)
(while (<= i steps)
(setq theta (/ (* i 1.0) cut))
(setq r (exp (* theta (tan in))))
(if (> r cut)(setq i steps))
(setq x (* r (cos theta)))
(setq y (* r (sin theta)))
(setq colore (1+ (fix (rn numc)))) ; non 0
(if (>= colore 255)(setq colore 2)) ; giallo
(command "_color" colore)
(command "_point" (list (+ (car p0)(rn numc) x)(+ (cadr p0)(rn numc) y)))
(setq i (1+ i))
)
(setq i 0)
(while (<= i steps)
(setq theta (/ (* i 1.0) cut))
(setq r (exp (* (+ theta pi)(tan in))))
(if (> r cut)(setq i steps))
(setq x (* r (cos theta)))
(setq y (* r (sin theta)))
(setq colore (1+ (fix (rn numc)))) ; non 0
(if (>= colore 255)(setq colore 2)) ; giallo
(command "_color" colore)
(command "_point" (list (+ (car p0)(rn numc) x)(+ (cadr p0)(rn numc) y)))
(setq i (1+ i))
)
)
(defun tan (in)(/ (sin in)(cos in)))
;|
Genera un numero reale casuale compreso tra 0 e numc
Vedi il tutorial n.37 "Numeri casuali"
in AutoLISP Tips & Tricks Volume I
|;
(defun rn ( numc / m b c )
(if (not sd)(setq sd (getvar "DATE")))
(setq m 65521 b 15937 c 33503)
(setq sd (rem (+ (* b sd) c) m))
(* (/ sd m) numc)
)
(defun c:glxy3 ( / sd snapp )
(setvar "cmdecho" 0)
(setq snapp (getvar "osmode"))
(command "_osnap" "_non")
(galaxy)
(setvar "osmode" snapp)
(command "_redraw")
(setvar "cecolor" "BYLAYER")
(setvar "cmdecho" 1)
(princ)
)
;;;eof
|
Test dei lisp
Command: glxy1
steps? [1000] Invio
curvatura? [0.2] Invio
cut off? [50] Invio
Command: glxy2
steps? [1000] Invio
curvatura? [0.2] Invio
cut off? [50] Invio
limite sup. intervallo num. casuali 0-? [7]: 13
Command: glxy3
steps? [1000] Invio
curvatura? [0.2] Invio
cut off? [50] Invio
limite sup. intervallo num. casuali 0-? [7]: Invio
clicca un punto:
Analisi del lisp
(* i 1.0)
Come per il lisp SHL si tratta di tracciare la curva della spirale logaritmica per valori discreti del parametro Θ.
In coordinate polari l'equazione della spirale logaritmica è r1=kevΘ, con k e v costanti arbitrarie; nei 3 lisp k=scale=1 e v=tan(in), cioè r=scale*exp(theta*tan(in)); (in pseudo-codice).
La posizione di ogni punto è data dalle due equazioni parametriche nel piano x=r*cos(Θ) e y=r*sin(Θ):
(setq x (* r (cos theta)))
(setq y (* r (sin theta)))
L'altro braccio della galassia a spirale si ottiene con una seconda spirale logaritmica r2=kev[Θ+pi] e ripetendo il loop.
In pseudo-codice theta=float(i)/50; cioè (setq theta (/ (* i 1.0) 50))
In Autolisp:
(setq i 1)
(/ i 50)
0
Quindi si deve forzare il risultato in questo modo:
(/ (* i 1.0) 50)
0.02
Lisp »Tips 'n Tricks
Ultimo Aggiornamento_Last Update: 14 Aprile 2005
|
|