;;; ========================================================================

;;; 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
```

```
```