cg-Cad

Lisp »Tips 'n Tricks »Funzioni ricorsive in AutoLISP »1 | 2 | 3 | 4 | 5 | 6 | 7 a , b , c , d , e >II >III >IV >V >VI >VII

I passi per disegnare il Drago di Heighway sono:

  • Fissa gli estremi del segmento AB (base del triangolo ACB);
  • Disegna il lato AC(1) e il lato BC(1) del triangolo, con gli angoli BAC e ABC di 45º;
  • Ripassa n volte per il secondo passo [con base=AC(n-1) e base=BC(n-1)], con la posizione del vertice C(n) alternata rispetto alla base.

DRAGON.LSP
Alla base del mio lisp c'è questo lisp (o meglio una parte di esso, quella di colore blu):

;;; -*-  Mode: LISP -*- Syntax: AutoLISP (C) Benjamin Olasov 1988
;;;      Functions to generate recursively defined drawings.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; File: DRAGON.LSP Copyright (C) Benjamin Olasov    Graphic Systems, Inc. ;;;
;;; Inquiries:                                                              ;;;
;;;                                                                         ;;;
;;;     Benjamin Olasov                                                     ;;;
;;;     Graphic Systems, Inc.:                                              ;;;
;;;                                                                         ;;;
;;;                    New York, NY:   PH (212) 725-4617                    ;;;
;;;                    Cambridge, MA:  PH (617) 492-1148                    ;;;
;;;                    MCI-Mail:       GSI-NY   344-4003                    ;;;
;;;                    Arpanet:        olasov@cs.columbia.edu               ;;;
;;;                                                                         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; This program is provided 'as is' without warranty of any kind, either 
;; expressed or implied, including, but not limited to the implied warranties of
;; merchantability and fitness for a particular purpose.  The entire risk as to
;; the quality and performance of the program is with the user.  Should the 
;; program prove defective, the user assumes the entire cost of all necessary 
;; servicing, repair or correction. 
;; AutoLisp and AutoCad are registered trademarks of AutoDesk, Inc.


(VMON)
(GC)
(TEXTSCR)
(PROMPT "\nC:DRAGON and C:C-CURVE generate recursively defined drawings.")

; Random number generator
(DEFUN RAN ()
 (SETQ SEED 
 (IF SEED 
  (REM 
   (+ (* SEED 15625.7) 0.21137152) 1) 0.3171943
  )
 )
)

(DEFUN C:DEMO () 
 (GRAPHSCR) 
 (DEFUN *ERROR* (MSG)(PRINC MSG))
 (SETQ CEN (GETVAR "VIEWCTR")
       HGT (GETVAR "VIEWSIZE")
       DIST1 HGT
 )
 (WHILE (/= 1 2)
  (SETQ DIST2 (* (RAN) DIST1)
        DIST3 (* (RAN) DIST1)
           A1 (* (/ PI 2.0) (RAN))
           A2 (* (/ PI 2.0) (RAN))
           P1 (POLAR CEN A1 DIST2)
           P2 (POLAR CEN A2 DIST3)
           LENG (DISTANCE P1 P2)
           MIN-LENG (MAX (/ HGT 161.8) (/ LENG 160.0)) 
               ANGL (ANGLE P1 P2)
              LEVEL 0)
  (DRAGON LENG ANGL (+ 0.0 1.0) MIN-LENG) 
  (REDRAW)
 )
 (PRINC)
)

(DEFUN PLOT-LINE (L A)
 (GRDRAW BASE (POLAR BASE A L) LEVEL)
 (SETQ BASE (POLAR BASE A L))
)

(DEFUN C-CURVE (LEN ANG MIN-LEN)
 (SETQ LEVEL (1+ LEVEL))
 (PRINC "\nLevel ")
 (PRINC LEVEL)
 (COND 
  ((< LEN MIN-LEN)
   (PRINC "\nPLOT-LINE at level ")
   (PRINC LEVEL)
   (PLOT-LINE LEN ANG)
  )
  (T 
   (C-CURVE (/ LEN (SQRT 2.0))(+ ANG (/ PI 4.0)) MIN-LEN)
   (C-CURVE (/ LEN (SQRT 2.0))(- ANG (/ PI 4.0)) MIN-LEN)
  )
 )
 (PROGN (SETQ LEVEL (1- LEVEL))
        (PRINC "\nLevel ")
        (PRINC LEVEL)
 )
)

(DEFUN C:C-CURVE (/ BASE PT2 ANGL MIN-LENG CURVE-VAR)
 (GRAPHSCR)
 (SETQ LENG (DISTANCE (SETQ BASE (GETPOINT "\nStarting point: "))
  (SETQ PT2 (GETPOINT BASE "\nDigitize length/ angle: "))) 
       ANGL (ANGLE BASE PT2) 
       MIN-LENG (MAX (/ (GETVAR "VIEWSIZE") 100.0) (/ LENG 160.0)) 
       LEVEL 0) 
 (C-CURVE LENG ANGL MIN-LENG) 
 (GETSTRING "\nPress Return to clear: ") 
 (REDRAW)
)

(DEFUN DRAGON (LEN ANG SIGN MIN-LEN)
 (SETQ LEVEL (1+ LEVEL))
 (PRINC "\nLevel ")
 (PRINC LEVEL)
 (COND 
  ((< LEN MIN-LEN)
   (PRINC "\nPLOT-LINE called at level ")
   (PRINC LEVEL)
   (PLOT-LINE LEN ANG)
  )
  (T 
   (DRAGON (/ LEN (SQRT 2.0))(+ ANG (* SIGN (/ PI 4.0))) +1.0 MIN-LEN)
   (DRAGON (/ LEN (SQRT 2.0))(- ANG (* SIGN (/ PI 4.0))) -1.0 MIN-LEN)
  )
 )
 (PROGN (SETQ LEVEL (1- LEVEL))
        (PRINC "\nLevel ")
        (PRINC LEVEL)
 )
)

(DEFUN C:DRAGON (/ BASE PT2 ANGL MIN-LENG CURVE-VAR) 
 (GRAPHSCR) 
 (SETQ LENG (DISTANCE (SETQ BASE (GETPOINT "\nStarting point: ")) 
  (SETQ PT2 (GETPOINT BASE "\nDigitize length/ angle: "))) 
        ANGL (ANGLE BASE PT2) 
        MIN-LENG (MAX (/ (GETVAR "VIEWSIZE") 100.0) (/ LENG 160.0)) 
        LEVEL 0) 
 (DRAGON LENG ANGL (+ 0.0 1.0) MIN-LENG) 
 (GETSTRING "\nPress RETURN to clear: ") 
 (REDRAW)
)

(PROMPT "\n\nType DRAGON or C-CURVE to generate a recursively defined drawing.")
(PRINC)

DHW.LSP

;;;
;;;    dhw.lsp - 7 Marzo 2004
;;;    (C) 2004 by Claudio Piccini.
;;;    www.cg-cad.com
;;;    
;;;    Drago di Heighway
;;;
;;;    Basato su:
;;;    DRAGON.LSP Copyright (C)1988 Benjamin Olasov
;;;    Graphic Systems, Inc.
;;;

(defun dragon (lung ang segno)
 (if (< lung n)
  (progn
   (setq p3 (polar p1 ang lung))
   (command "_line" p1 p3 "")
   (setq p1 (polar p1 ang lung))
  )
  (progn
   (dragon (/ lung (sqrt 2.0))(+ ang (* segno 0.785398)) +1.0)
   (dragon (/ lung (sqrt 2.0))(- ang (* segno 0.785398)) -1.0)
  )
 )
)

(defun c:dhw (/ snapp p1 p2 ang lung n segno)
 (setvar "cmdecho" 0)
 (setq snapp (getvar "osmode"))
 (command "_osnap" "_non")
 (setq segno 1.0)
 (setq p1 (getpoint "\nClicca un'estremita' del segmento"))
 (setq p2 (getpoint p1 "\nClicca l'altra estremita': "))
 (setq n (getint "\nNumero iterazioni: "))
 (setq ang (angle p1 p2))
 (setq lung (distance p1 p2))
 (setq n (/ lung n))
 (dragon lung ang segno) 
 (setvar "osmode" snapp)
 (command "_redraw")
 (setvar "cmdecho" 1)
 (princ)
)
;;;eof

Analisi del LISP

(/ lung (sqrt 2.0) = AC = BC.
Il segmento AB (segmento iniziale della procedura Heighway) è il lato (corda) del quadrato inscritto nel cerchio: AC e BC sono di uguale misura (sono raggi r dello stesso cerchio), l'angolo ACB è di 90°, per il teorema di Pitagora
AB² = AC² + BC²
AB² = (+ (* r r)(* r r))
AB = (sqrt (+ (* r r)(* r r)))
AB = (sqrt (* 2 r r))
AB = (* r (sqrt 2))
AB = lung, vedi nel lisp (setq lung (distance p1 p2))
r = AC = BC = (/ lung (sqrt 2).

(/ pi 4.0) -> (* pi (/ 45 180.0)) = 0.785398.

Test del LISP

1Command: dhw
Clicca un'estremita' del segmento
Clicca l'altra estremita':
Numero iterazioni: 1



2Command: dhw
Clicca un'estremita' del segmento
Clicca l'altra estremita':
Numero iterazioni: 2



3Command: dhw
Clicca un'estremita' del segmento
Clicca l'altra estremita':
Numero iterazioni: 3



DHW.LSPCommand: dhw
Clicca un'estremita' del segmento
Clicca l'altra estremita':
Numero iterazioni: 50



DHW2.LSP

;;;
;;;    dhw2.lsp - 7 Marzo 2004
;;;    (C) 2004 by Claudio Piccini.
;;;    www.cg-cad.com
;;;    
;;;    2 Draghi di Heighway
;;;
;;;    Basato su:
;;;    DRAGON.LSP Copyright (C)1988 Benjamin Olasov
;;;    Graphic Systems, Inc.
;;;

(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"))
)

(defun ripVar ()
 (command "_redraw")
 (setvar "cmdecho" 1)
 (setvar "osmode" snapp)
 (setvar "snapmode" snm)
 (setvar "orthomode" orto)
 (setvar "clayer" piano)
 (setvar "cecolor" "BYLAYER")
 (setq *error* olderr)
 (princ)
)

(defun drago1 (lung ang segno)
 (if (< lung n)
  (progn
   (setq p3 (polar p1 ang lung))
   (command "_line" p1 p3 "")
   (setq p1 (polar p1 ang lung))
  )
  (progn
   (drago1 (/ lung (sqrt 2.0))(+ ang (* segno 0.785398)) +1.0)
   (drago1 (/ lung (sqrt 2.0))(- ang (* segno 0.785398)) -1.0)
  )
 )
)

(defun drago2 (lung ang segno)
 (if (< lung n)
  (progn
   (setq p3 (polar p1 ang lung))
   (command "_line" p1 p3 "")
   (setq p1 (polar p1 ang lung))
  )
  (progn
   (drago2 (/ lung (sqrt 2.0))(+ ang (* segno 0.785398)) +1.0)
   (drago2 (/ lung (sqrt 2.0))(- ang (* segno 0.785398)) -1.0)
  )
 )
)

(defun c:dhw2 (/ p1 p2 p11 p22 ang lung n segno
                 olderr orto snapp snm piano
 )
 (setq olderr  *error*  *error* myerror)
 (setvar "cmdecho" 0)
 (salVar)
 (command "_osnap" "_non")
 (setq segno 1.0)
 (setq p1 (getpoint "\nClicca un'estremita' del segmento"))
 (setq p2 (getpoint p1 "\nClicca l'altra estremita': "))
 (setq n (getint "\nNumero iterazioni: "))
 (setq ang (angle p1 p2))
 (setq lung (distance p1 p2))
 (setq p11 (polar p1 (- ang 1.5708)(/ lung 5.0)))
 (setq p22 (polar p2 (- ang 1.5708)(/ lung 5.0)))
 (setq n (/ lung n))
 (command "_color" "_red")
 (drago1 lung ang segno)
 (command "_color" "_yellow")
 (setq p1 p11)
 (setq p2 p22)
 (drago2 lung ang segno)
 (ripVar)
)
;;;eof

Test del LISP

Command: dhw2
Clicca un'estremita' del segmento
Clicca l'altra estremita':
Numero iterazioni: 50

DHW2.LSP
2 draghi con 50 iterazioni.



DHW3.LSP

;;;
;;;    dhw3.lsp - 7 Marzo 2004
;;;    (C) 2004 by Claudio Piccini.
;;;    www.cg-cad.com
;;;
;;;    Basato su:
;;;    DRAGON.LSP Copyright (C)1988 Benjamin Olasov
;;;    Graphic Systems, Inc.
;;;

(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"))
)

(defun ripVar ()
 (command "_redraw")
 (setvar "cmdecho" 1)
 (setvar "osmode" snapp)
 (setvar "snapmode" snm)
 (setvar "orthomode" orto)
 (setvar "clayer" piano)
 (setvar "cecolor" "BYLAYER")
 (setq *error* olderr)
 (princ)
)

(defun curva (lung ang segno)
 (if (< lung n)
  (progn
   (setq p3 (polar p1 ang lung))
   (command "_line" p1 p3 "")
   (setq p1 (polar p1 ang lung))
  )
  (progn ;30°
   (curva (/ lung (sqrt 3.0))(+ ang (* segno 0.523599)) +1.0)
   (curva (/ lung (sqrt 3.0))(- ang (* segno 0.523599)) -1.0)
  )
 )
)

(defun c:dhw3 (/ p1 p2 ang lung n segno
                 olderr orto snapp snm piano
 )
 (setq olderr  *error*  *error* myerror)
 (setvar "cmdecho" 0)
 (salVar)
 (command "_osnap" "_non")
 (setq segno 1.0)
 (setq p1 (getpoint "\nClicca un'estremita' del segmento"))
 (setq p2 (getpoint p1 "\nClicca l'altra estremita': "))
 (command "_color" "_red")
 (command "_line" p1 p2 "")
 (setq n (getint "\nNumero iterazioni: "))
 (setq ang (angle p1 p2))
 (setq lung (distance p1 p2))
 (setq n (/ lung n))
 (command "_color" "_yellow")
 (curva lung ang segno)
 (ripVar)
)
;;;eof

Test del LISP

Command: dhw3
Clicca un'estremita' del segmento
Clicca l'altra estremita':
Numero iterazioni: 100

DHW3.LSP

Effetto nuvola:

(defun curva (lung ang segno)
 (if (< lung n)
  (progn
   (setq p3 (polar p1 ang lung))
   (command "_line" p1 p3 "")
   (setq p1 (polar p1 ang lung))
  )
  (progn
   (curva (/ lung (sqrt 3.0))(+ ang (* segno 0.523599)) +1.0)
   (curva (/ lung (sqrt 3.0))(- ang (* segno 0.523599)) +1.0)
  )
 )
)

Effetto crepa nel muro:

(defun curva (lung ang segno)
 (if (< lung n)
  (progn
   (setq p3 (polar p1 ang lung))
   (command "_line" p1 p3 "")
   (setq p1 (polar p1 ang lung))
  )
  (progn
   (curva (/ lung (sqrt 3.0))(+ ang (* segno 0.523599)) +1.0)
   (curva (/ lung (sqrt 3.0))(- ang (* segno 0.523599)) +1.0)
   (curva (/ lung (sqrt 3.0))(- ang (* segno 0.523599)) +1.0)
   (curva (/ lung (sqrt 3.0))(+ ang (* segno 0.523599)) +1.0)
  )
 )
)

Effetto cespuglio:

(defun curva (lung ang segno)
 (if (< lung n)
  (progn
   (setq p3 (polar p1 ang lung))
   (command "_line" p1 p3 "")
   (setq p1 (polar p1 ang lung))
  )
  (progn 
   (curva (/ lung (sqrt 3.0))(+ ang (* segno 0.523599)) +1.0)
   (curva (/ lung (sqrt 2.0))(- ang (* segno 0.785398)) -1.0)
  )
 )
)

Lisp »Tips 'n Tricks

Ultimo Aggiornamento_Last Update: 7 Marzo 2004