;;; ========================================================================
;;; The following code are writen by CHEN QING JUN ;
;;; Civil engineering Department, South China University of Technology ;
;;; Purpose: To draw some regular pattern, just for fun ;
;;; something like one toy we play, put a pen in one hole that ;
;;; inside a small gear, that moving the pen to let the small gear;
;;; rolling along a big gear, then the pen draw beautiful pattern ;
;;; I call this "kaleidoscope1" ;
;;; The platform: Acad14 and after ;
;;; Method: use the parameter to define the x y cordinate,just so ;
;;; 2002.07.24 ;
;;; Http://autolisper.googlepages.com ;
;;; Http://qjchen.googlepages.com ;
;;; Http://chenqj.blogspot.com ;
;;; ========================================================================

(defun c:flower2 (/ lst r1 r2 r3 rad color alpha beta orign orignx orignyp1
p2 rep add)
(setq lst (getpattern1)
r1 (nth 0 lst)
r2 (nth 1 lst)
r3 (nth 2 lst)
rad (nth 3 lst)
rep (nth 4 lst)
add (nth 5 lst)
alpha 0
beta 0
orign (getpoint "\n the insertion point of fractal flower:")
orignx (car orign)
origny (cadr orign)
)
(entmake (list (cons 0 "CIRCLE")
(cons 6 "BYLAYER")
(cons 8 "0")
(cons 10 orign)
(cons 40 r1)
(cons 62 8)
)
)
(setq i 1)
(setq color 10)
(command "color" color "")
(while ( beta (* add i))
(progn
(setq i (+ i 1))
(setq color (+ color 10))
(command "color" color "")
)
)
(setq alpha (* -1 (* beta (/ r2 (+ r1 r2)))))
(setq x1 (+ orignx (* r1 (cos alpha)) (* r3 (cos beta))))
(setq y1 (+ origny (* r1 (sin alpha)) (* r3 (sin beta))))
(setq p1 (list x1 y1 0.0))
(setq beta (+ beta 0.05))
(entmake (list (cons 0 "CIRCLE")
(cons 6 "BYLAYER")
(cons 8 "0")
(cons 10 p1)
(cons 40 rad)
(cons 62 color)
)
)

)
)
(defun getpattern1 (/ kword pattern pattern1)
(initget "1 2")
(setq kword (getkword "\n please select the type of flower: 1/2:"))
(cond
((= kword "1")
(setq res (list 20.0 14.3 7 0.2 75.2 3.14))
)
((= kword "2")
(setq res (list 20.0 15 15 1 44 2.14))
)
)
res
)
(prompt "\n Type flower2 to invoke \n")

Advertisements