;;; ========================================================================
;;; Some of the following code are writen by CHEN QING JUN ;
;;; Civil engineering Department, South China University of Technology ;
;;; Purpose: To draw tree according to the fractal theory, just for fun ;
;;; The command name :tree ;
;;; The platform: Acad14 and after ;
;;; Version: 0.2 ;
;;; Limitation: no random pattern is concerned ;
;;; Method: use the LS gramma to define the tree (multi-param) ;
;;; omega:the original configuration ;
;;; ang :the original angle ;
;;; P1a and P1, P2a and P2,... five pair rule, P1a->P1, and so on ;
;;; It is hard to image this gramma, but maybe something in it ;
;;; 2006.07.23 ;
;;; The codes idea camed from The book wrote by Sun Bo Wen ;
;;; ;
;;; Http://autolisper.googlepages.com ;
;;; Http://qjchen.googlepages.com ;
;;; ========================================================================
(defun c:tree (/ os plst ang omega P1a P1 P2a P2 P3a P3 P4a P4 P5a P5 color
len ori oriang
)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq plst (getpattern)
ang (dtor (nth 0 plst))
omega (nth 1 plst)
P1a (nth 2 plst)
P1 (nth 3 plst)
P2a (nth 4 plst)
P2 (nth 5 plst)
P3a (nth 6 plst)
P3 (nth 7 plst)
P4a (nth 8 plst)
P4 (nth 9 plst)
P5a (nth 10 plst)
P5 (nth 11 plst)
len 100
ori (getpoint "\n The start point")
oriang (dtor 90.0)
color 84
)
(repeat (nth 12 plst)
(if P1a
(setq omega (my-subst P1 P1A omega))
)
(if P2a
(setq omega (my-subst P2 P2A omega))
)
(if P3a
(setq omega (my-subst P3 P3A omega))
)
(if P4a
(setq omega (my-subst P4 P4A omega))
)
(if P5a
(setq omega (my-subst P5 P5A omega))
)
)
(drawomega omega ori oriang)
(COMMAND "ZOOM" "E" "zoom" ".9x")
(setvar "osmode" os)
)
;;degreed to radian;;
(defun dtor (x)
(* (/ x 180) pi)
)
;;;get tree pattern;;
(defun getpattern (/ kword pattern pattern1)
(initget "1 2 3 4 5 6 7")
(setq kword (getkword "\n please select the tree type: 1/2/3/4/5/6/7:"))
(cond
((= kword "1")
(setq res (list 20.0 "X" "F" "FF" "X" "F[+X]F[-X]+X" nil nil nil nil
nil nil 6
)
)
)
((= kword "2")
(setq res (list 30.0 "Z" "X" "X[-FFF][+FFF]FX" "Z" "ZFX[+Z][-Z]" nil
nil nil nil nil nil 6
)
)
)
((= kword "3")
(setq res (list 22.5 "F" "F" "FF-[XY]+[XY]" "X" "+FY" "Y" "-FX" nil
nil nil nil 4
)
)
)
((= kword "4")
(setq res (list 5.0 "G" "G" "GFX[+++++GFG][-----GFG]" "X" "F-XF" nil
nil nil nil nil nil 4
)
)
)
((= kword "5")
(setq res (list 25.7 "X" "F" "FF" "X" "F[+X][-X]FX" nil nil nil nil
nil nil 7
)
)
)
((= kword "6")
(setq res (list 45.0 "FX" "F" "" "X" "-FX++FX-" nil nil nil nil nil
nil 10
)
)
)
((= kword "7")
(setq res (list 30.0 "G" "G" "[+FGF][-FGF]XG" "X" "XFX" nil nil nil
nil nil nil 6
)
)
)
)
res
)
;;;;draw finalomega
(defun drawomega (omega ori oriang / i slen x ori1 templst)
(setq i 1
slen (strlen omega)
)
(repeat slen
(setq x (substr omega i 1))
(cond
((= x "F")
(setq ori1 (polar ori oriang len))
(make_line ori ori1 color)
(setq ori ori1)
)
((= x "[")
(setq templst (append
templst
(list (list oriang ori))
)
color 80
)
)
((= x "]")
(setq oriang (car (last templst))
ori (cadr (last templst))
templst (1ton_1 templst)
color 84
)
)
((= x "+")
(setq oriang (+ oriang ang))
)
((= x "-")
(setq oriang (- oriang ang))
)
)
(setq i (1+ i))
)
)
;;;to substitute every one item(strlen=1) to new item
(defun my-subst (new old str / slen i res)
(setq i 1
res ""
)
(if (setq slen (strlen str))
(repeat slen
(setq stri (substr str i 1)
i (1+ i)
)
(if (= old stri)
(setq res (strcat res new))
(setq res (strcat res stri))
)
)
)
res
)
;;xoutside function to entmake line
(defun make_Line (l10 l11 color)
(ENTMAKE (LIST (CONS 0 "LINE") (cons 62 color) (cons 10 l10)
(cons 11 l11)
)
)
)
;; get the 1 to (n-1) element of a list
(defun 1ton_1 (lst)
(reverse (cdr (reverse lst)))
)
(princ "\n")
(prompt "\n Type tree to invoke \n")
(c:tree)

Advertisements