Fractal play

The first Lisp is just a classical example:

(defun c:fract3( / a b c)
   (defun mid(a b)
     (mapcar '* (mapcar '+ a b) '(0.5 0.5 0.5))
     )
   (defun draw(a b c)
     (entmake (list '(0 . "LINE") (cons 10 a) (cons 11 b)))
     (entmake (list '(0 . "LINE") (cons 10 b) (cons 11 c)))
     (entmake (list '(0 . "LINE") (cons 10 c) (cons 11 a)))
     (if (< 0.1 (distance a b))
       (progn
             (draw a (mid a b) (mid c a))
             (draw (mid a b) b (mid b c))
             (draw (mid b c) (mid c a) c)
             )
       )
     )
   (setq a (polar '(0 0 0) (/ PI 2) 25)
             b (polar '(0 0 0) (/ (* PI 7) 6) 25)
             c (polar '(0 0 0) (/ PI -6) 25)
             )
   (draw a b c)
   )

It uses recursion to draw more and more lines forming smaller and smaller triangles. It stops when the line to be drawn becomes smaller as 0.1 drawing units. Myself I wonder how short the program is –that demonstrates the power of Lisp.

The second program: I started it having the break line symbol in my mind. This time I give up with the recursion, the user controls how deep to go. It starts from a line and it breaks it in tree. The first line is kept for reference (the green one) and each run of the program breaks all the lines generated at the previous step. There is list declared as global variable, to keep the data between program runs. How to use it: Load the program and run it first. After that probable you will need to zoom. Run the program again, and again… just press the space bar to get to the next level.

(defun subdiv(e)
   (setq fx 0.4 fa 0.5)
   (setq el (entget e)
             a (cdr (assoc 10 el))
             b (cdr (assoc 11 el))
             d1 (distance a b)
             a1 (angle a b)
             a2 (angle b a)
             )
   (entmake (list '(0 . "LINE") (cons 10 a) (cons 11 (setq c (polar a (+ a1 fa) (* d1 fx))))))
   (setq l1 (cons (entlast) l1))
   (entmake (list '(0 . "LINE") (cons 10 c) (cons 11 (setq d (polar b (+ a2 fa) (* d1 fx))))))
   (setq l1 (cons (entlast) l1))
   (entmake (list '(0 . "LINE") (cons 10 d) (cons 11 b)))
   (setq l1 (cons (entlast) l1))
   (entdel e)
   )
 (defun c:fract( / e l1)
   (if (not l) (progn
                         (entmake (list '(0 . "LINE") '(10 0 0 0) '(11 100 0 0) '(62 . 3)))
                         (entmake (list '(0 . "LINE") '(10 0 0 0) '(11 100 0 0)))
                         (setq l (list (entlast)))
                         ))
   (setq l1 nil)
   (foreach e l (subdiv e))
   (setq l l1)
   )

I think that keeping the list of lines between runs is not a good practice, so here is the third lisp. It draws a line, but that in fact is a block. Use it like the previous program to get more and more blocks inserted in your drawing. Maybe you will ask why I used a block just for a simple line. Well, after I got the first image, I simple edited the block and AutoCAD returned what I posted here as the next image. (I manually changed the first block to green, just to better show what I mean).

(defun c:tree()
   (defun insert (p ang dim)
     (entmake (list (cons 0 "INSERT") '(2 . "X") (cons 10 p) (cons 41 dim) (cons 42 dim) (cons 43 dim) (cons 50 ang)))
     )
   (setq sc 0.58 ang1 0.75 ang2 0.6 pz1 0.85 pz2 0.65)
  
   (if (not (tblsearch "block" "x"))
     (progn
       (entmake (list '(0 . "BLOCK") '(100 . "AcDbEntity") '(67 . 0) '(8 . "0")
                              '(100 . "AcDbBlockBegin") '(70 . 0) '(10 0 0 0) '(2 . "x") '(1 . "")))
       (entmake (list '(0 . "LINE") '(10 0 0 0) '(11 1 0 0)))
       (entmake '((0 . "EndBlk") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockEnd")))
       (entmake '((0 . "INSERT") (2 . "x") (10 0 0 0) (41 . 1) (42 . 1) (43 . 1) (50 . 0)))
       )
     (progn
       (setq ss (ssget "X" (list '(0 . "INSERT") '(2 . "X"))) i (sslength ss))
       (repeat i
             (setq el (entget (ssname ss (setq i (1- i))))
                   p (cdr (assoc 10 el))
                   ang (cdr (assoc 50 el))
                   dim (cdr (assoc 41 el))
                   )
             (insert (polar p ang (* dim pz1)) (+ ang ang1) (* dim sc))
             (insert (polar p ang (* dim pz2)) (- ang ang2) (* dim sc))
             )
       )
     )
   )

And the last Lisp is for moving in the third dimension. Run it once. Shade the model if needed (wireframe doesn’t look nice), zoom and orbit to catch a good angle. Now run the program again and again… until your computer hangs-up itself.

(defun blmake( / p1 p2 p3 p4)
   (setq p1 '(0 0 0) p2 '( 1 0 0)
             p3 (list 0.5 (/ (sqrt 3) 2) 0)
             p4 (list 0.5 (/ (sqrt 3) 6) (/ (sqrt 6) 3))
             )
   (entmake (list '(0 . "BLOCK") '(100 . "AcDbEntity") '(67 . 0) '(8 . "0")
                          '(100 . "AcDbBlockBegin") '(70 . 0) '(10 0 0 0)
                          '(2 . "Thetraedron") '(1 . "")))
   (entmake (list '(0 . "3DFACE") (cons 10 p1) (cons 11 p2) (cons 12 p3) (cons 13 p4)))
   (entmake (list '(0 . "3DFACE") (cons 10 p2) (cons 11 p1) (cons 12 p4) (cons 13 p3)))
   (entmake '((0 . "EndBlk") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockEnd")))
   )
  
       
 (defun subdiv(e l / ip ins)
   (setq ip (cdr (assoc 10 (entget e))))
   (setq ins (list ip
                           (mapcar '+ ip (list (+ l l) 0 0))
                           (mapcar '+ ip (list (/ l 1.0) (/ (* l (sqrt 3.0)) 1.0) 0))
                           (mapcar '+ ip (list (/ l 1.0) (/ (* l (sqrt 3.0)) 3.0) (/ (* l (sqrt 6.0)) 1.5)))
                           )
             )
   (foreach a ins
     (entmake (list '(0 . "INSERT") '(2 . "Thetraedron") (cons 10 a) (cons 41 (* 2 l)) (cons 42 (* 2 l)) (cons 43 (* 2 l))))
     )
   (entdel e)
   )
 (defun c:fract3d( / i ss)
   (if (not (tblsearch "block" "thetraedron"))
     (progn
       (blmake)
       (setq l 1.0 iter -1)
       (entmake '((0 . "INSERT") (2 . "Thetraedron") (10 0 0 0) (41 . 2) (42 . 2) (43 . 2)))
       )
     (progn
       (setq l (/ l 2.0))
       (setq ss (ssget "X" (list (cons 0 "INSERT"))))
       (setq i (sslength ss))
       (repeat i
             (subdiv (ssname ss (setq i (1- i))) l)
             )
       )
     )
   (itoa (setq iter (1+ iter)))
   ) 

Nice work Fuccaro! Very interesting indeed

You might also be interested in this and this

Lee

Thank you, Lee. I have seen those master posts before. Here is my amateurish try.

Thank you, Lee. I have seen those master posts before. Here is my amateurish try.

Thanks Fuccaro, but your posts are in no way amateurish - your 3D Sierpinski Triangle is impressive

Lee- I checked out the links that you had attached in this thread and they were indeed impressive. I was wondering if you've ever checked out Paul Nylander's site. It's chock-full of interesting stuff. He seems to use mathematica to generate his fractals. http://bugman123.com/index.html

Very nice indeed! Thanks Steven

Forgot to include this thread also - another interesting area of mathematics

Hello!

I found my old toy and I lisped some again. I used the same program with minor changes to get these images:

and here is the program:

(defun c:cir( / O R)
 (setq O (list 0 0 0)
   R 100.0)
 (draw1 O R)
 )

(defun draw1(o r / ls i)
 (setq i 0 ls nil)
 (repeat 4
   (setq ls (cons (cons 42 -0.414214) ls))
   (setq ls (cons (cons 10 (polar o (* (setq i (1+ i)) PI 0.5) r)) ls))
   )
 (setq ls (cons '(0 . "LWPOLYLINE") (cons '(100 . "AcDbEntity") (cons '(100 . "AcDbPolyline") (cons  '(90 . 4) (cons '(70 . 1) ls))))))

 
 (entmake ls)
 (if (> r 10) (progn
        (draw1 (polar o Pi (/ r 2.0)) (/ r 2.0))
        (draw1 (polar o 0 (/ r 2.0)) (/ r 2.0))
        ))
 )

And a special variation for the incoming Valentine day:

This is the program for the last image:

(defun c:cir( / O R)
 (setq O (list 0 0 0)
   R 200.0)
 (draw1 O R)
 )

(defun draw1(o r / ls i)
 (setq i 0 ls nil)
 (repeat 4
   (setq ls (cons (cons 42 (fix (* -0.5 (+ 2 (* 1.5 (cos (* 0.4 i PI))))))) ls))
   (setq ls (cons (cons 10 (polar o (* (setq i (1+ i)) PI 0.5) r)) ls))
   )
 (setq ls (cons '(0 . "LWPOLYLINE") (cons '(100 . "AcDbEntity") (cons '(100 . "AcDbPolyline") (cons  '(90 . 4) (cons '(70 . 1) ls))))))

 
 (entmake ls)
 (if (> r 30) (progn
        (draw1 (polar o Pi (/ r 2.0)) (/ r 2.0))
        (draw1 (polar o 0 (/ r 2.0)) (/ r 2.0))
        ))
 )

Very nice..... keep it up....

Hello People!

I had some time so I wrote a Lisp for this Julia set. I can not upload here the animated gif, so here are some some images during zooming in.

Excellent work fuccaro!

What object did you use to display the fractal?

(I used Point objects to form the image, with the zoom magnification scaled such that there is a point per pixel)

Hello Lee!

Thank you for your kind comment.

I used the point entities too, at a resolution of 500x500, without to concern about the zoom factor; I simply resized the AutoCAD window, until it looked fine. After that I started the lisp and it generated the images using the outjpg command. The computer worked about 3 hours to generate 25 images and I put them together in an animated gif. Unfortunately I cannot post the animation, probable the file size is to big…

Also the color mapping is the simplest one: if the point felt out of the circle after say 9 iterations, then the point get the color no 9 (according to AutoCAD color scheme).

I am not an artist, I am happy I got those images –I wrote the program for my own pleasure and I decided to share these images here.

Thanks again, have a good day!

To simplify my computer's job, this time I drew only the points with color (meaning iterations) between 5 and 250 (that's it, 250 is the max number of iterations I considered).

Probable the last image I post about this: moving in the 3rd dimension.

Fuccaro, it is really refreshing to see that you still enjoy going outside of the box and making a little magic, after all these years, very nicely done!

Very good fuccaro! - The next challenge is the Mandelbulb

Using the formula Z=Z^2 +C I've got the previous images. For Z=Z^-2 +C I've got this:

Sierpinski again, this time following the rules of the probabilities.

Lee Mac, with your kind permission, I used two of your routines -just worked as expected, thank you!

(defun c:Sierpinski()
 (setq v (list '(1 1 0) '(0 1 1) '(1 0 1) '(0 0 0))) ;vertices
 (repeat 500
   (setq point (list (LM:randrange -2 2) (LM:randrange -2 2) (LM:randrange -2 2)))
   (repeat 25 (setq point (next point)))
   (repeat 500
     (setq point (next point))
     (entmake (list (cons 0 "POINT")
            (cons 10 point)
            (cons 62 (fix (apply '+ (mapcar '* '(3 9 40 111) (mapcar 'distance (list point point point point) v)))))))
   )
  )
 )

(defun next (p)
 (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p (nth (LM:randrange 0 3) v)))
 )
 

;; Rand  -  Lee Mac
;; PRNG implementing a linear congruential generator with
;; parameters derived from the book 'Numerical Recipes'

(defun LM:rand ( / a c m )
   (setq m   4294967296.0
         a   1664525.0
         c   1013904223.0
         $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m)
   )
   (/ $xn m)
)
;; Random in Range  -  Lee Mac
;; Returns a pseudo-random integral number in a given range (inclusive)

(defun LM:randrange ( a b )
   (+ (min a b) (fix (* (LM:rand) (1+ (abs (- a b))))))
)