;;; --------------------------------------------------------------------------- ;;; TreeGrow.lsp ;;; code compiled by YZ August 2026 ;;; --------------------------------------------------------------------------- ;;; BRANCHING TREES AND PLANTS ;;; ;;; PURPOSE ;;; Grows a branching structure from a trunk you draw - a tree in elevation ;;; for a landscape drawing, or the same machinery turned to other uses: ;;; a wiring diagram, a decision tree, a river system. ;;; ;;; FRACTREE every branch splits the same way every time, so the result is ;;; regular and symmetrical - the classic fractal tree ;;; PLANTGROW the split angles wander, so no two branches match and the tree ;;; looks as though it grew rather than being drawn ;;; ;;; HOW IT GROWS ;;; Start with a trunk. At its far end, sprout branches at a set angle either ;;; side and one straight on, each shorter than the trunk by a fixed factor. ;;; Then do the same to every one of those. The number of branches multiplies ;;; by three each round, so six rounds is over a thousand lines and nine is ;;; near thirty thousand - which is why the count is capped and reported ;;; before anything is drawn. ;;; ;;; WHAT WAS FIXED ;;; The fractal version worked on whatever object happened to be drawn LAST, ;;; with no way to choose. It saved a named view called "fractree" to zoom ;;; about while it ran and left that view in the drawing. It ended by ;;; returning nil rather than (princ), so the console filled with nil. Every ;;; variable was global, including a, d, e, p1 and p2. ;;; ;;; The random version had a worse problem. Its random angles came from ;;; ;;; (setq s (* (getvar "cdate") 10000000.0)) ;;; (setq s (* pi (- s (fix s)))) ;;; ;;; CDATE is the date and time as YYYYMMDD.HHMMSS - it changes once a SECOND. ;;; Inside a loop that runs in microseconds it returns the same value over and ;;; over, so every branch in a generation took the identical angle and the ;;; "random" tree came out as a fan of straight lines. There is a proper ;;; generator here now. ;;; ;;; It also needed a block called "leaf" that had to already exist, set the ;;; drawing colour once per generation and never put it back, and could ask ;;; for colour 200-something on a deep run. ;;; ;;; FRACTREE - a regular branching tree ;;; PLANTGROW - an irregular one ;;; --------------------------------------------------------------------------- ;;; --------------------------------------------------------------------------- ;;; RANDOM NUMBERS ;;; ;;; AutoLISP has none, and the clock is far too coarse to stand in for one. This ;;; is a linear congruential generator - the constants are Park and Miller's, ;;; chosen so the sequence runs through every value before repeating. ;;; --------------------------------------------------------------------------- (if (null *TreeGrow:Seed*) ;; Seeded once from the fraction of the day, so each session differs. (setq *TreeGrow:Seed* (1+ (fix (* 100000.0 (- (getvar "DATE") (fix (getvar "DATE"))))))) ) ;;; A real between 0 and 1. (defun Tree:Random ( ) (setq *TreeGrow:Seed* (rem (* 16807.0 *TreeGrow:Seed*) 2147483647.0)) (/ *TreeGrow:Seed* 2147483647.0) ) ;;; A real between -SPREAD and +SPREAD. (defun Tree:Jitter ( spread ) (* spread (- (* 2.0 (Tree:Random)) 1.0))) ;;; --------------------------------------------------------------------------- ;;; DRAWING ;;; --------------------------------------------------------------------------- (defun Tree:Layer ( name colour ) (if (not (tblsearch "LAYER" name)) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 name) '(70 . 0) (cons 62 colour) '(6 . "Continuous")))) name ) ;;; A branch, drawn with a width that tapers as the generations get finer, so ;;; the trunk reads as heavier than the twigs. (defun Tree:Branch ( p1 p2 layer width ) (if (> width 1e-9) (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 layer) '(100 . "AcDbPolyline") '(90 . 2) '(70 . 0) (cons 10 (list (car p1) (cadr p1))) (cons 40 width) (cons 41 (* width 0.75)) '(42 . 0.0) (cons 10 (list (car p2) (cadr p2))) (cons 40 (* width 0.75)) (cons 41 (* width 0.75)) '(42 . 0.0))) (entmake (list '(0 . "LINE") (cons 8 layer) (cons 10 p1) (cons 11 p2)))) ) ;;; --------------------------------------------------------------------------- ;;; GROWING ;;; ;;; Worked through a list of ends rather than by recursion. Each round takes the ;;; ends left by the last one and sprouts from all of them, which keeps the ;;; whole generation at the same size and avoids piling up a deep call stack. ;;; ;;; Each end is (point . angle) - where the branch finished and which way it was ;;; heading when it got there. ;;; --------------------------------------------------------------------------- (defun Tree:Grow ( start ang len gens spread shrink jitter layer width / ends nxt p p2 a a2 i drawn ) (setq ends (list (cons start ang)) drawn 0 i 0) (while (< i gens) (setq nxt nil) (foreach e ends (setq p (car e) a (cdr e)) ;; Three branches: left, straight on, right. The jitter is zero for ;; a regular tree and grows the irregular one. (foreach turn (list (- spread) 0.0 spread) (setq a2 (+ a turn (Tree:Jitter jitter)) p2 (polar p a2 len)) (Tree:Branch p p2 layer width) (setq nxt (cons (cons p2 a2) nxt) drawn (1+ drawn)))) (setq ends nxt len (* len shrink) width (* width shrink) i (1+ i))) drawn ) ;;; Shared front end. RANDOM is nil for a regular tree. (defun Tree:Run ( random / *error* vars vals p1 p2 ang len gens spread shrink jitter lay n total width v ) (setq vars '("CMDECHO" "BLIPMODE" "OSMODE" "CLAYER") vals (mapcar 'getvar vars)) (defun Tree:Restore ( ) (mapcar 'setvar vars vals) (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End")) (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '()) (princ) ) (defun *error* ( msg ) (Tree:Restore) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** TREE error: " msg " **"))) (princ) ) (setvar "CMDECHO" 0) (setvar "BLIPMODE" 0) ;; AutoCAD 2015 and later refuse (command) inside an *error* handler unless ;; the routine says up front that it will use one. (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '()) (command "_.UNDO" "_Begin") (princ "\nDraw the trunk: from its base to where the branching starts.") (setq p1 (getpoint "\nBase of the trunk: ")) (if p1 (setq p2 (getpoint p1 "\nTop of the trunk: "))) (if (or (null p1) (null p2)) (princ "\nCancelled.") (progn (setvar "OSMODE" 0) (setq ang (angle p1 p2) len (distance p1 p2)) (initget 6) (setq gens (getint "\nGenerations of branching <5>: ")) (if (null gens) (setq gens 5)) (if (> gens 9) (progn (princ "\n Nine is the most that finishes in reasonable time.") (setq gens 9))) ;; Say how much work it is before doing any of it. (setq total 0 n 1) (repeat gens (setq n (* n 3) total (+ total n))) (princ (strcat "\n That is " (itoa total) " branches.")) (if (> total 5000) (progn (initget "Yes No") (if (= "No" (getkword "\n Go ahead [Yes/No] : ")) (setq gens 0)))) (if (> gens 0) (progn (initget 6) (setq spread (getreal "\nAngle between branches, degrees <60>: ")) (if (null spread) (setq spread 60.0)) (setq spread (/ (* pi spread) 180.0)) (initget 6) (setq shrink (getreal "\nEach generation shorter by a factor of <0.4>: ")) (if (or (null shrink) (>= shrink 1.0)) (setq shrink 0.4)) (setq jitter 0.0) (if random (progn (initget 4) (setq v (getreal "\nHow much the angles wander, degrees <25>: ")) (if (null v) (setq v 25.0)) (setq jitter (/ (* pi v) 180.0)))) (setq lay (Tree:Layer (if random "Planting" "Tree") 3) width (/ len 25.0)) ;; The trunk itself. (Tree:Branch p1 p2 lay width) (setq n (Tree:Grow p2 ang (* len shrink) gens spread shrink jitter lay (* width shrink))) (princ (strcat "\n" (itoa (1+ n)) " branches drawn on layer " lay "."))))) ) (Tree:Restore) (princ) ) (defun c:FRACTREE ( ) (Tree:Run nil)) (defun c:PLANTGROW ( ) (Tree:Run t)) (princ)