;;; ========================================================================
;;; 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 "kaleidoscope" ;
;;; The platform: Acad14 and after ;
;;; Method: use the parameter to define the x y cordinate,just so ;
;;; 2002.07.23 ;
;;; Http://autolisper.googlepages.com ;
;;; Http://qjchen.googlepages.com ;
;;; Http://chenqj.blogspot.com ;
;;; ========================================================================
(defun c:flower1 (/ lst r1 r2 r3 r4 color alpha beta orign orignx orignyp1 p2)
(setq lst (getpattern)
r1 (nth 0 lst)
r2 (nth 1 lst)
r3 (nth 2 lst)
r4 (- r1 r2)
color (nth 3 lst)
alpha 0
beta 0
orign (getpoint "\n the insertion point of fractal flower:")
orignx (car orign)
origny (cadr orign)
)
(command "color" color "")
(while (< beta 314)
(setq alpha (* -1 (* beta (/ r2 (+ r4 r2)))))
(setq p1 (list (+ orignx (* r4 (cos alpha)) (* r3 (cos beta)))
(+ origny (* r4 (sin alpha)) (* r3 (sin beta)))
0
)
)
(setq beta (+ beta 0.05))
(setq alpha (* -1 (* beta (/ r2 (+ r4 r2)))))
(setq p2 (list (+ orignx (* r4 (cos alpha)) (* r3 (cos beta)))
(+ origny (* r4 (sin alpha)) (* r3 (sin beta)))
0
)
)
(command "line" p1 p2 "")
)
)
(defun getpattern (/ kword pattern pattern1)
(initget "1 2 3 4 5 6 7 8 9 10")
(setq kword (getkword "\n Please select the type of flower: 1/2/3/4/5/6/7/8/9/10:"))
(cond
((= kword "1")
(setq res (list 20.0 14.3 7 1))
)
((= kword "2")
(setq res (list 20.0 14.3 15 2))
)
((= kword "3")
(setq res (list 20.0 10.3 5 3))
)
((= kword "4")
(setq res (list 20.0 12 8 4))
)
((= kword "5")
(setq res (list 20.0 9 1 5))
)
((= kword "6")
(setq res (list 20.0 9 5 131))
)
((= kword "7")
(setq res (list 20.0 9 7 30))
)
((= kword "8")
(setq res (list 20.0 8 5 220))
)
((= kword "9")
(setq res (list 20.0 5.2 4.2 170))
)
((= kword "10")
(setq res (list 20.0 5.2 2.2 140))
)
)
res
)
(prompt "\n Type flower1 to invoke \n")

Advertisements