;;; ========================================================================
;;; Some of the following code are writen by CHEN QING JUN ;
;;; Civil engineering Department, South China University of Technology ;
;;; Purpose: To draw IFS fractal pattern, just for fun ;
;;; The command name :tree ;
;;; The platform: Acad14 and after ;
;;; Version: 0.1 ;
;;; Method: use the IFS method to construt the drawing ;
;;; in the pattern define,just like the first pattern: ;
;;; (list (list 0.5 0.0 0.0 0.5 0.0 0.0 0.333) ;
;;; (list 0.5 0.0 0.0 0.5 0.5 0.0 0.333) ;
;;; (list 0.5 0.0 0.0 0.5 0.25 0.5 0.334)) ;
;;; there are 3 elements, (it can be different, 2,4,5,6 or bigger ;
;;; at each end ,0.333 0.333 0.334 represent the probability, ;
;;; then I construct a rndlst (0.333 0.666 1) ;
;;; while the other 6 parameters are for a b c d e f ;
;;; which is for transformation: ;
;;; x'=ax+by+e ;
;;; y'=cx+dy+f ;
;;; so generate a random number (here I use Smadsen's function) ;
;;; judge this num in which district of the rndlst ;
;;; then judge which a b c d e f should be used. ;
;;; according to new x, draw point, then repeat ;
;;; 2006.07.24 ;
;;; 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 iteration ori orix oriy color rndlst position
neworix neworiy
)
(setq os (getvar "osmode"))
(setq cmd (getvar "cmdecho"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq plst (getpattern)
iteration 20000
ori (getpoint "\n The start point")
x (car ori)
y (cadr ori)
orix 0.0
oriy 0.0
color 80

)
;(if (= k nil) (setq k 10) (setq k (+ k 10)) )
(setq rndlst (getrndlst plst))
(repeat iteration
(setq a (rng))
(setq position (my-position a rndlst))
(setq newx (+ (* orix (nth 0 (nth position plst)))
(* oriy (nth 1 (nth position plst)))
(nth 4 (nth position plst))
)
)
(setq newy (+ (* orix (nth 2 (nth position plst)))
(* oriy (nth 3 (nth position plst)))
(nth 5 (nth position plst))
)
)
(setq orix newx
oriy newy
)
;(setq color (+ (* (fix (* (+ 1.4 oriy) 3)) 10)) 20)
;(setq color (+ (* position 2) 100))
(make_point (list (+ orix x) (+ oriy y) 0.0) color)
;(command "color" k)
;(command "point" (list (+ orix x) (+ oriy y) 0.0))
)
(COMMAND "ZOOM" "E" "zoom" ".9x")
(setvar "osmode" os)
(setvar "cmdecho" cmd)
)
;;;get tree pattern;;
(defun getpattern (/ kword pattern pattern1)
(initget "1 2 3 4 5 6 7 8 9 10")
(setq kword (getkword "\n please select the tree type: 1/2/3/4/5/6/7/8/9/10:"))
(cond
((= kword "1")
(setq res (list (list 0.5 0.0 0.0 0.5 0.0 0.0 0.333)
(list 0.5 0.0 0.0 0.5 0.5 0.0 0.333)
(list 0.5 0.0 0.0 0.5 0.25 0.5 0.334)
)
)
)
((= kword "2")
(setq res (list (list 0.5 -0.5 0.5 0.5 0.0 0.0 0.5)
(list 0.5 0.5 -0.5 0.5 0.5 0.5 0.5)
)
)
)
((= kword "3")
(setq res (list (list -0.04 0 -0.19 -0.47 -0.12 0.3 0.25)
(list 0.65 0.0 0.0 0.56 0.06 1.56 0.25)
(list 0.41 0.46 -0.39 0.61 0.46 0.4 0.25)
(list 0.52 -0.35 0.25 0.74 -0.48 0.38 0.25)
)
)
)
((= kword "4")
(setq res (list (list 0.6 0 0 0.6 0.18 0.36 0.25)
(list 0.6 0 0 0.6 0.18 0.120 0.25)
(list 0.4 0.3 -0.3 0.4 0.27 0.36 0.25)
(list 0.4 -0.3 0.3 0.4 0.27 0.09 0.25)
)
)
)
((= kword "5")
(setq res (list
(list 0.787879 -0.424242 0.242424 0.859848 1.758647 1.408065 0.9)
(list -0.121212 0.257576 0.05303 0.05303 -6.721654 1.377236 0.05)
(list 0.181818 -0.136364 0.090909 0.181818 6.086107 1.568035 0.05)

)
)
)
((= kword "6")
(setq res (list
(list 0.745455 -0.45901 0.406061 0.887121 1.460279 0.691072 0.912675)
(list -0.424242 -0.065152 -0.175758 -0.218182 3.809567 6.741476 0.087325)
)
)
)
((= kword "7")
(setq res (list (list 0 0 0 0.25 0 -0.14 0.02)
(list 0.85 0.02 -0.02 0.83 0 1 0.84)
(list 0.09 -0.28 0.3 0.11 0 0.6 0.07)
(list -0.09 0.25 0.3 0.09 0 0.7 0.07)
)
)
)
((= kword "8")
(setq res (list (list 0.05 0 0 0.6 0 0 0.1)
(list 0.05 0 0 -0.5 0 1.0 0.1)
(list 0.46 0.32 -0.386 0.383 0 0.6 0.2)
(list 0.47 -0.154 0.171 0.423 0 1.0 0.2)
(list 0.43 0.275 -0.26 0.476 0 1.0 0.2)
(list 0.421 -0.357 0.354 0.307 0 0.7 0.2)
)
)
)
((= kword "9")
(setq res (list (list 0 0 0 0.16 0 0 0.01)
(list 0.85 0.04 -0.04 0.85 0 1.6 0.85)
(list 0.2 -0.26 0.23 0.22 0 1.6 0.07)
(list -0.15 0.28 0.26 0.24 0 0.44 0.07)
)
)
)
((= kword "10")
(setq res (list (list 0.8 0.0 0.0 -0.8 0.0 0.0 0.5)
(list 0.4 -0.2 0.2 0.4 1.1 0.0 0.5)
)
)
)
)
res
)
;;xoutside function to entmake line
(defun make_point (l10 color)
(ENTMAKE (LIST (CONS 0 "POINT") (cons 62 color) (cons 10 l10)))
)
;; random number
(defun rng (/ modulus multiplier increment random)
(if (not seed)
(setq seed (getvar "DATE"))
)
(setq modulus 4294967296.0
multiplier 1664525
increment 1
seed (rem (+ (* multiplier seed) increment) modulus)
random (/ seed modulus)
)
)
;; judge the position
(defun my-position (x lst / i lenlst x res k)
(setq i 0
k 0
lenlst (length lst)
)
(repeat lenlst
(if (and
(= k 0)
(<= x (nth i lst))
)
(setq res i
k 1
)
)
(setq i (1+ i))
)
res
)
;; get the accumulate list
(defun getrndlst (lst / rndlst a x rndlst1)
(foreach x plst
(setq rndlst (append
rndlst
(list (last x))
)
)
)
(setq a 0)
(foreach x rndlst
(setq a (+ a x))
(setq rndlst1 (append
rndlst1
(list a)
)
)
)
rndlst1
)
(princ "\n")
(prompt "\n use LS gramma to draw tree, command:tree \n")
(c:tree)

Advertisements