Author Topic: ===[CHALLENGE - hex fractal]===  (Read 3607 times)

0 Members and 1 Guest are viewing this topic.

Jeremy Dunn

  • Newt
  • Posts: 31
===[CHALLENGE - hex fractal]===
« on: March 19, 2018, 01:07:38 AM »
The diagram shows a three stage development of a fractal that is based on the 7 hex unit on the left. One repeats 6 hex units and leaves the central hex empty. The challenge is to write a program that will draw any generation of the pattern given the iteration integer. The program should draw the pattern without repeating edges and calculate points in such a way as to have as little cumulative error as possible. Let the programs begin!

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: ===[CHALLENGE - hex fractal]===
« Reply #1 on: March 19, 2018, 06:37:24 AM »
Another one...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: ===[CHALLENGE - hex fractal]===
« Reply #2 on: March 19, 2018, 09:04:30 AM »
And yet another one...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: ===[CHALLENGE - hex fractal]===
« Reply #3 on: March 19, 2018, 02:08:27 PM »
Not exactly what you wanted, but I managed to get this...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: ===[CHALLENGE - hex fractal]===
« Reply #4 on: March 19, 2018, 02:17:41 PM »
Here are my attempts :

Code - Auto/Visual Lisp: [Select]
  1. (defun c:fractals-3sided ( / fill odd even adoc p r rr p1 p2 p3 n k )
  2.  
  3.  
  4.   (defun fill ( e / hatch )
  5.  
  6.     (vl-load-com)
  7.  
  8.     (setq hatch (vla-addhatch (vla-get-block (vla-get-activelayout adoc)) acHatchPatternTypePredefined "SOLID" :vlax-true AcHatchObject))
  9.     (vla-appendouterloop hatch (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0)) (list (vlax-ename->vla-object e))))
  10.   )
  11.  
  12.   (defun odd ( r / p1 p2 p3 ss i e el ) ; p is global
  13.  
  14.     (vl-load-com)
  15.  
  16.     (setq p1 (polar p (/ (* 7 pi) 6) r))
  17.     (setq p2 (polar p (/ (* 11 pi) 6) r))
  18.     (setq p3 (polar p (/ pi 2) r))
  19.     (setq ss (ssget "_A"))
  20.     (repeat (setq i (sslength ss))
  21.       (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
  22.       (setq el (cons e el))
  23.     )
  24.     (foreach e el
  25.       (vla-mirror e (vlax-3d-point p1) (vlax-3d-point p2))
  26.     )
  27.     (foreach e el
  28.       (vla-mirror e (vlax-3d-point p2) (vlax-3d-point p3))
  29.     )
  30.     (foreach e el
  31.       (vla-mirror e (vlax-3d-point p3) (vlax-3d-point p1))
  32.     )
  33.     (foreach e el
  34.       (vla-delete e)
  35.     )
  36.     (fill (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 3) (cons 70 (1+ (* 128 (getvar 'plinegen)))) (cons 10 p1) (cons 10 p2) (cons 10 p3) '(210 0.0 0.0 1.0))))
  37.   )
  38.  
  39.   (defun even ( r / p1 p2 p3 ss i e el ) ; p is global
  40.  
  41.     (vl-load-com)
  42.  
  43.     (setq p1 (polar p (/ pi 6) r))
  44.     (setq p2 (polar p (/ (* 5 pi) 6) r))
  45.     (setq p3 (polar p (/ (* 3 pi) 2) r))
  46.     (setq ss (ssget "_A"))
  47.     (repeat (setq i (sslength ss))
  48.       (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
  49.       (setq el (cons e el))
  50.     )
  51.     (foreach e el
  52.       (vla-mirror e (vlax-3d-point p1) (vlax-3d-point p2))
  53.     )
  54.     (foreach e el
  55.       (vla-mirror e (vlax-3d-point p2) (vlax-3d-point p3))
  56.     )
  57.     (foreach e el
  58.       (vla-mirror e (vlax-3d-point p3) (vlax-3d-point p1))
  59.     )
  60.     (foreach e el
  61.       (vla-delete e)
  62.     )
  63.     (fill (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 3) (cons 70 (1+ (* 128 (getvar 'plinegen)))) (cons 10 p1) (cons 10 p2) (cons 10 p3) '(210 0.0 0.0 1.0))))
  64.   )
  65.  
  66.   (initget 1)
  67.   (setq p (getpoint "\nPick or specify center point : "))
  68.   (initget 7)
  69.   (setq rr (getdist p "\nSpecify initial radius of triangle : "))
  70.   (setq r (/ rr 2))
  71.   (setq p1 (polar p (/ (* 7 pi) 6) rr))
  72.   (setq p2 (polar p (/ (* 11 pi) 6) rr))
  73.   (setq p3 (polar p (/ pi 2) rr))
  74.   (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 3) (cons 70 (1+ (* 128 (getvar 'plinegen)))) (cons 10 p1) (cons 10 p2) (cons 10 p3) '(210 0.0 0.0 1.0)))
  75.   (initget 7)
  76.   (setq n (getint "\nSpecify number of iterations : "))
  77.   (setq k 0)
  78.   (repeat n
  79.     (setq k (1+ k))
  80.     (if (= 1 (rem k 2))
  81.       (odd (setq r (* 2 r)))
  82.       (even (setq r (* 2 r)))
  83.     )
  84.   )
  85.   (princ)
  86. )
  87.  

Code - Auto/Visual Lisp: [Select]
  1. (defun c:fractals-4sided ( / fill foo adoc p r rr p1 p2 p3 p4 n )
  2.  
  3.  
  4.   (defun fill ( e / hatch )
  5.  
  6.     (vl-load-com)
  7.  
  8.     (setq hatch (vla-addhatch (vla-get-block (vla-get-activelayout adoc)) acHatchPatternTypePredefined "SOLID" :vlax-true AcHatchObject))
  9.     (vla-appendouterloop hatch (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0)) (list (vlax-ename->vla-object e))))
  10.   )
  11.  
  12.   (defun foo ( r / p1 p2 p3 p4 ss i e el ) ; p is global
  13.  
  14.     (vl-load-com)
  15.  
  16.     (setq p1 (polar p (/ (* 5 pi) 4) r))
  17.     (setq p2 (polar p (/ (* 7 pi) 4) r))
  18.     (setq p3 (polar p (/ pi 4) r))
  19.     (setq p4 (polar p (/ (* 3 pi) 4) r))
  20.     (setq ss (ssget "_A"))
  21.     (repeat (setq i (sslength ss))
  22.       (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
  23.       (setq el (cons e el))
  24.     )
  25.     (foreach e el
  26.       (vla-mirror e (vlax-3d-point p1) (vlax-3d-point p2))
  27.     )
  28.     (foreach e el
  29.       (vla-mirror e (vlax-3d-point p2) (vlax-3d-point p3))
  30.     )
  31.     (foreach e el
  32.       (vla-mirror e (vlax-3d-point p3) (vlax-3d-point p4))
  33.     )
  34.     (foreach e el
  35.       (vla-mirror e (vlax-3d-point p4) (vlax-3d-point p1))
  36.     )
  37.     (foreach e el
  38.       (vla-mirror e (vlax-3d-point (polar p1 (/ (* 3 pi) 4) 1.0)) (vlax-3d-point (polar p1 (/ (* 7 pi) 4) 1.0)))
  39.     )
  40.     (foreach e el
  41.       (vla-mirror e (vlax-3d-point (polar p2 (/ (* 5 pi) 4) 1.0)) (vlax-3d-point (polar p2 (/ pi 4) 1.0)))
  42.     )
  43.     (foreach e el
  44.       (vla-mirror e (vlax-3d-point (polar p3 (/ (* 7 pi) 4) 1.0)) (vlax-3d-point (polar p3 (/ (* 3 pi) 4) 1.0)))
  45.     )
  46.     (foreach e el
  47.       (vla-mirror e (vlax-3d-point (polar p4 (/ pi 4) 1.0)) (vlax-3d-point (polar p4 (/ (* 5 pi) 4) 1.0)))
  48.     )
  49.     (foreach e el
  50.       (vla-delete e)
  51.     )
  52.     (fill (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) (cons 70 (1+ (* 128 (getvar 'plinegen)))) (cons 10 p1) (cons 10 p2) (cons 10 p3) (cons 10 p4) '(210 0.0 0.0 1.0))))
  53.   )
  54.  
  55.   (initget 1)
  56.   (setq p (getpoint "\nPick or specify center point : "))
  57.   (initget 7)
  58.   (setq r (getdist p "\nSpecify initial radius of square : "))
  59.   (setq rr (/ r 3))
  60.   (setq p1 (polar p (/ (* 5 pi) 4) r))
  61.   (setq p2 (polar p (/ (* 7 pi) 4) r))
  62.   (setq p3 (polar p (/ pi 4) r))
  63.   (setq p4 (polar p (/ (* 3 pi) 4) r))
  64.   (setq r rr)
  65.   (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) (cons 70 (1+ (* 128 (getvar 'plinegen)))) (cons 10 p1) (cons 10 p2) (cons 10 p3) (cons 10 p4) '(210 0.0 0.0 1.0)))
  66.   (initget 7)
  67.   (setq n (getint "\nSpecify number of iterations : "))
  68.   (repeat n
  69.     (foo (setq r (* 3 r)))
  70.   )
  71.   (princ)
  72. )
  73.  

Code - Auto/Visual Lisp: [Select]
  1. (defun c:fractals-6sided ( / fill foo adoc p r rr p1 p2 p3 p4 p5 p6 n )
  2.  
  3.  
  4.   (defun fill ( e / hatch )
  5.  
  6.     (vl-load-com)
  7.  
  8.     (setq hatch (vla-addhatch (vla-get-block (vla-get-activelayout adoc)) acHatchPatternTypePredefined "SOLID" :vlax-true AcHatchObject))
  9.     (vla-appendouterloop hatch (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0)) (list (vlax-ename->vla-object e))))
  10.   )
  11.  
  12.   (defun foo ( r / p1 p2 p3 p4 p5 p6 ss i e el ) ; p is global
  13.  
  14.     (vl-load-com)
  15.  
  16.     (setq p1 (polar p (/ (* 4 pi) 3) r))
  17.     (setq p2 (polar p (/ (* 5 pi) 3) r))
  18.     (setq p3 (polar p 0.0 r))
  19.     (setq p4 (polar p (/ pi 3) r))
  20.     (setq p5 (polar p (/ (* 2 pi) 3) r))
  21.     (setq p6 (polar p pi r))
  22.     (setq ss (ssget "_A"))
  23.     (repeat (setq i (sslength ss))
  24.       (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
  25.       (setq el (cons e el))
  26.     )
  27.     (foreach e el
  28.       (vla-mirror e (vlax-3d-point p1) (vlax-3d-point p2))
  29.     )
  30.     (foreach e el
  31.       (vla-mirror e (vlax-3d-point p2) (vlax-3d-point p3))
  32.     )
  33.     (foreach e el
  34.       (vla-mirror e (vlax-3d-point p3) (vlax-3d-point p4))
  35.     )
  36.     (foreach e el
  37.       (vla-mirror e (vlax-3d-point p4) (vlax-3d-point p5))
  38.     )
  39.     (foreach e el
  40.       (vla-mirror e (vlax-3d-point p5) (vlax-3d-point p6))
  41.     )
  42.     (foreach e el
  43.       (vla-mirror e (vlax-3d-point p6) (vlax-3d-point p1))
  44.     )
  45.     (foreach e el
  46.       (vla-delete e)
  47.     )
  48.     (fill (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 6) (cons 70 (1+ (* 128 (getvar 'plinegen)))) (cons 10 p1) (cons 10 p2) (cons 10 p3) (cons 10 p4) (cons 10 p5) (cons 10 p6) '(210 0.0 0.0 1.0))))
  49.   )
  50.  
  51.   (initget 1)
  52.   (setq p (getpoint "\nPick or specify center point : "))
  53.   (initget 7)
  54.   (setq r (getdist p "\nSpecify initial radius of hexagon : "))
  55.   (setq rr (/ r 3))
  56.   (setq p1 (polar p (/ (* 4 pi) 3) r))
  57.   (setq p2 (polar p (/ (* 5 pi) 3) r))
  58.   (setq p3 (polar p 0.0 r))
  59.   (setq p4 (polar p (/ pi 3) r))
  60.   (setq p5 (polar p (/ (* 2 pi) 3) r))
  61.   (setq p6 (polar p pi r))
  62.   (setq r rr)
  63.   (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 6) (cons 70 (1+ (* 128 (getvar 'plinegen)))) (cons 10 p1) (cons 10 p2) (cons 10 p3) (cons 10 p4) (cons 10 p5) (cons 10 p6) '(210 0.0 0.0 1.0)))
  64.   (initget 7)
  65.   (setq n (getint "\nSpecify number of iterations : "))
  66.   (repeat n
  67.     (foo (setq r (* 3 r)))
  68.   )
  69.   (princ)
  70. )
  71.  

HTH., M.R.
« Last Edit: March 19, 2018, 10:59:49 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: ===[CHALLENGE - hex fractal]===
« Reply #5 on: March 19, 2018, 02:35:22 PM »
Hi,

No time to play right now, but here's an old one for Sierpinski triangle.

Code - Auto/Visual Lisp: [Select]
  1. (defun drawSierpinski (i p1 p2 p3 / draw mid loop fract)
  2.   (defun draw (p1 p2 p3)
  3.     (entmake (list '(0 . "SOLID") (cons 10 p1) (cons 11 p2) (cons 12 p3) (cons 13 p3)))
  4.   )
  5.   (defun mid (p1 p2)
  6.     (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.)) p1 p2)
  7.   )
  8.   (defun loop (i p1 p2 p3)
  9.     (if (< 0 i)
  10.       (fract (1- i) p1 p2 p3)
  11.       (draw p1 p2 p3)
  12.     )
  13.   )
  14.   (defun fract (i p1 p2 p3)
  15.     (loop i p1 (mid p1 p2) (mid p3 p1))
  16.     (loop i (mid p1 p2) p2 (mid p2 p3))
  17.     (loop i (mid p3 p1) (mid p2 p3) p3)
  18.   )
  19.   (loop i p1 p2 p3)
  20. )

Testing command:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:test (/ i c r)
  2.   (and
  3.     (setq i (getint "\nNumber of iteration: "))
  4.     (setq c (getpoint "\nCenter: "))
  5.     (setq r (getdist c "\nRadius: "))
  6.     (drawSierpinski
  7.       i
  8.       (polar c (/ pi 2) r)
  9.       (polar c (/ (* 7 pi) 6) r)
  10.       (polar c (/ (* 11 pi) 6) r)
  11.     )
  12.   )
  13.   (princ)
  14. )
Speaking English as a French Frog

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: ===[CHALLENGE - hex fractal]===
« Reply #6 on: March 19, 2018, 11:02:21 PM »
Here is my revision of 6sided - just slightly more elegant, but result is also different than original request...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:fractals-6sided-new ( / fill foo adoc p r rr p1 p2 p3 p4 p5 p6 n )
  2.  
  3.  
  4.   (defun fill ( e / hatch )
  5.  
  6.     (vl-load-com)
  7.  
  8.     (setq hatch (vla-addhatch (vla-get-block (vla-get-activelayout adoc)) acHatchPatternTypePredefined "SOLID" :vlax-true AcHatchObject))
  9.     (vla-appendouterloop hatch (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0)) (list (vlax-ename->vla-object e))))
  10.   )
  11.  
  12.   (defun foo ( r / p1 p2 p3 p4 p5 p6 ss i e el ) ; p is global
  13.  
  14.     (vl-load-com)
  15.  
  16.     (setq p1 (polar p (/ (* 4 pi) 3) r))
  17.     (setq p2 (polar p (/ (* 5 pi) 3) r))
  18.     (setq p3 (polar p 0.0 r))
  19.     (setq p4 (polar p (/ pi 3) r))
  20.     (setq p5 (polar p (/ (* 2 pi) 3) r))
  21.     (setq p6 (polar p pi r))
  22.     (setq ss (ssget "_A"))
  23.     (repeat (setq i (sslength ss))
  24.       (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
  25.       (setq el (cons e el))
  26.     )
  27.     (foreach e el
  28.       (vla-mirror e (vlax-3d-point p1) (vlax-3d-point p2))
  29.     )
  30.     (foreach e el
  31.       (vla-mirror e (vlax-3d-point p2) (vlax-3d-point p3))
  32.     )
  33.     (foreach e el
  34.       (vla-mirror e (vlax-3d-point p3) (vlax-3d-point p4))
  35.     )
  36.     (foreach e el
  37.       (vla-mirror e (vlax-3d-point p4) (vlax-3d-point p5))
  38.     )
  39.     (foreach e el
  40.       (vla-mirror e (vlax-3d-point p5) (vlax-3d-point p6))
  41.     )
  42.     (foreach e el
  43.       (vla-mirror e (vlax-3d-point p6) (vlax-3d-point p1))
  44.     )
  45.     (foreach e el
  46.       (if (= (cdr (assoc 0 (entget (vlax-vla-object->ename e)))) "HATCH")
  47.         (vla-delete e)
  48.         (fill (vlax-vla-object->ename e))
  49.       )
  50.     )
  51.   )
  52.  
  53.   (initget 1)
  54.   (setq p (getpoint "\nPick or specify center point : "))
  55.   (initget 7)
  56.   (setq r (getdist p "\nSpecify initial radius of hexagon : "))
  57.   (setq rr (/ r 3))
  58.   (setq p1 (polar p (/ (* 4 pi) 3) r))
  59.   (setq p2 (polar p (/ (* 5 pi) 3) r))
  60.   (setq p3 (polar p 0.0 r))
  61.   (setq p4 (polar p (/ pi 3) r))
  62.   (setq p5 (polar p (/ (* 2 pi) 3) r))
  63.   (setq p6 (polar p pi r))
  64.   (setq r rr)
  65.   (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 6) (cons 70 (1+ (* 128 (getvar 'plinegen)))) (cons 10 p1) (cons 10 p2) (cons 10 p3) (cons 10 p4) (cons 10 p5) (cons 10 p6) '(210 0.0 0.0 1.0)))
  66.   (initget 7)
  67.   (setq n (getint "\nSpecify number of iterations : "))
  68.   (repeat n
  69.     (foo (setq r (* 3 r)))
  70.   )
  71.   (princ)
  72. )
  73.  

M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: ===[CHALLENGE - hex fractal]===
« Reply #7 on: March 20, 2018, 11:38:47 AM »
Code - Auto/Visual Lisp: [Select]
  1. (defun hexfractal (i pts / draw loop fract)
  2.   (defun draw (pts)
  3.     (entmake
  4.       (append
  5.         '((0 . "LWPOLYLINE")
  6.           (100 . "AcDbEntity")
  7.           (100 . "AcDbPolyline")
  8.           (90 . 6)
  9.           (70 . 1)
  10.          )
  11.         (mapcar '(lambda (p) (cons 10 p)) pts)
  12.       )
  13.     )
  14.   )
  15.   (defun loop (i pts)
  16.     (if (< 0 i)
  17.       (fract (1- i) pts)
  18.       (draw pts)
  19.     )
  20.   )
  21.   (defun fract (i pts / d)
  22.     (setq d (/ (distance (car pts) (cadr pts)) 3))
  23.     (mapcar
  24.       '(lambda (p1 p2 / a)
  25.          (setq a (angle p1 p2))
  26.          (loop i
  27.                (mapcar
  28.                  '(lambda (n) (setq p1 (polar p1 (+ a (* k n)) d)))
  29.                  '(0 0 1 2 3 4)
  30.                )
  31.          )
  32.        )
  33.       pts
  34.       (append (cdr pts) (list (car pts)))
  35.     )
  36.   )
  37.   (setq k (/ pi 3))
  38.   (loop i pts)
  39. )
  40.  
  41. (defun c:test (/ i c r a)
  42.   (and
  43.     (setq i (getint "\nNumber of iterations: "))
  44.     (setq c (getpoint "\nCenter: "))
  45.     (setq r (getdist c "\nRadius: "))
  46.     (setq a (/ pi 6))
  47.     (hexfractal
  48.       i
  49.       (mapcar '(lambda (x) (polar c (* x a) r))
  50.               '(1 3 5 7 9 11)
  51.       )
  52.     )
  53.   )
  54.   (princ)
  55. )

Speaking English as a French Frog

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: ===[CHALLENGE - hex fractal]===
« Reply #8 on: March 20, 2018, 12:45:11 PM »
Slightly different.

Code - Auto/Visual Lisp: [Select]
  1. (defun hexfractal (i pts / draw loop fract c)
  2.   (defun draw (pts)
  3.     (entmake
  4.       (append
  5.         '((0 . "LWPOLYLINE")
  6.           (100 . "AcDbEntity")
  7.           (100 . "AcDbPolyline")
  8.           (90 . 6)
  9.           (70 . 1)
  10.          )
  11.         (mapcar '(lambda (p) (cons 10 p)) pts)
  12.       )
  13.     )
  14.   )
  15.   (defun loop (i pts)
  16.     (if (< 0 i)
  17.       (fract (1- i) pts)
  18.       (draw pts)
  19.     )
  20.   )
  21.   (defun fract (i pts / d)
  22.     (setq d (/ (distance (car pts) (cadr pts)) 3.))
  23.     (mapcar
  24.       '(lambda (p1 p2 / a)
  25.          (setq a (angle p1 p2))
  26.          (loop i
  27.                (mapcar '(lambda (k) (setq p1 (polar p1 (+ (* k c) a) d)))
  28.                        '(0 1 2 3 4 5)
  29.                )
  30.          )
  31.        )
  32.       pts
  33.       (append (cdr pts) (list (car pts)))
  34.     )
  35.   )
  36.   (setq c (/ pi 3.))
  37.   (loop i pts)
  38. )
Speaking English as a French Frog

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: ===[CHALLENGE - hex fractal]===
« Reply #9 on: March 20, 2018, 01:47:59 PM »
Hi Gilles...

I've finished what OP wanted...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:fractals-6sided-new-new ( / fill array odd even adoc p r p1 p2 p3 p4 p5 p6 e n k )
  2.  
  3.  
  4.   (defun fill ( e / hatch )
  5.  
  6.     (vl-load-com)
  7.  
  8.     (setq hatch (vla-addhatch (vla-get-block (vla-get-activelayout adoc)) acHatchPatternTypePredefined "SOLID" :vlax-true AcHatchObject))
  9.     (vla-appendouterloop hatch (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0)) (list (vlax-ename->vla-object e))))
  10.   )
  11.  
  12.   (defun array ( e p n / da k )
  13.  
  14.     (vl-load-com)
  15.  
  16.     (setq da (/ (* 2 pi) n))
  17.     (setq k 0)
  18.     (repeat (1- n)
  19.       (setq k (1+ k))
  20.       (vla-copy (vlax-ename->vla-object e))
  21.       (vla-rotate (vlax-ename->vla-object (entlast)) (vlax-3d-point p) (* k da))
  22.     )
  23.   )
  24.  
  25.   (defun odd ( n / ss i e el p1 p2 ell ) ; p is global ; r is global
  26.  
  27.     (vl-load-com)
  28.  
  29.     (setq ss (ssget "_A"))
  30.     (repeat (setq i (sslength ss))
  31.       (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
  32.       (setq el (cons e el))
  33.     )
  34.     (setq p1 (polar (polar p (/ (* 5 pi) 3) (* 2 r (if (= n 1) 1 (expt 7.0 (1- n))))) 0.0 (* r (if (= n 1) 1 (expt 7.0 (1- n))))))
  35.     (setq p2 (polar (polar p pi (* 2 r (if (= n 1) 1 (expt 7.0 (1- n))))) (/ (* 4 pi) 3) (* r (if (= n 1) 1 (expt 7.0 (1- n))))))
  36.     (foreach e el
  37.       (vla-copy e)
  38.       (vla-move (vlax-ename->vla-object (entlast)) (vlax-3d-point p1) (vlax-3d-point p2))
  39.       (setq ell (cons (entlast) ell))
  40.     )
  41.     (foreach e ell
  42.       (array e p 6)
  43.     )
  44.     (foreach e el
  45.       (if (= (cdr (assoc 0 (entget (vlax-vla-object->ename e)))) "HATCH")
  46.         (vla-delete e)
  47.         (fill (vlax-vla-object->ename e))
  48.       )
  49.     )
  50.   )
  51.  
  52.   (defun even ( n / ss i e el p1 p2 ell ) ; p is global ; r is global
  53.  
  54.     (vl-load-com)
  55.  
  56.     (setq ss (ssget "_A"))
  57.     (repeat (setq i (sslength ss))
  58.       (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
  59.       (setq el (cons e el))
  60.     )
  61.     (setq p1 (polar (polar p (/ (* 5 pi) 3) (* 4 r (if (= n 1) 1 (expt 7.0 (1- n))))) 0.0 (* 2 r (if (= n 1) 1 (expt 7.0 (1- n))))))
  62.     (setq p2 (polar (polar p (/ pi 2) (* 3 (/ (* r (sqrt 3.0)) 2) (if (= n 1) 1 (expt 7.0 (1- n))))) pi (* 6.5 r (if (= n 1) 1 (expt 7.0 (1- n))))))
  63.     (foreach e el
  64.       (vla-copy e)
  65.       (vla-move (vlax-ename->vla-object (entlast)) (vlax-3d-point p1) (vlax-3d-point p2))
  66.       (setq ell (cons (entlast) ell))
  67.     )
  68.     (foreach e ell
  69.       (array e p 6)
  70.     )
  71.     (foreach e el
  72.       (if (= (cdr (assoc 0 (entget (vlax-vla-object->ename e)))) "HATCH")
  73.         (vla-delete e)
  74.         (fill (vlax-vla-object->ename e))
  75.       )
  76.     )
  77.   )
  78.  
  79.   (initget 1)
  80.   (setq p (getpoint "\nPick or specify center point : "))
  81.   (initget 7)
  82.   (setq r (getdist p "\nSpecify initial radius of hexagon : "))
  83.   (setq p1 (polar p (/ (* 4 pi) 3) r))
  84.   (setq p2 (polar p (/ (* 5 pi) 3) r))
  85.   (setq p3 (polar p 0.0 r))
  86.   (setq p4 (polar p (/ pi 3) r))
  87.   (setq p5 (polar p (/ (* 2 pi) 3) r))
  88.   (setq p6 (polar p pi r))
  89.   (setq e (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 6) (cons 70 (1+ (* 128 (getvar 'plinegen)))) (cons 10 p1) (cons 10 p2) (cons 10 p3) (cons 10 p4) (cons 10 p5) (cons 10 p6) '(210 0.0 0.0 1.0))))
  90.   (vla-copy (vlax-ename->vla-object e))
  91.   (vla-move (vlax-ename->vla-object (entlast)) (vlax-3d-point p2) (vlax-3d-point p6))
  92.   (array (entlast) p 6)
  93.   (fill e)
  94.   (initget 7)
  95.   (setq n (getint "\nSpecify number of iterations : "))
  96.   (setq k 0)
  97.   (repeat n
  98.     (setq k (1+ k))
  99.     (if (= 1 (rem k 2))
  100.       (odd (1+ (/ k 2)))
  101.       (even (/ k 2))
  102.     )
  103.   )
  104.   (princ)
  105. )
  106.  

M.R.
« Last Edit: March 20, 2018, 11:00:16 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: ===[CHALLENGE - hex fractal]===
« Reply #10 on: March 20, 2018, 02:14:12 PM »
Nice!
Speaking English as a French Frog

Jeremy Dunn

  • Newt
  • Posts: 31
Re: ===[CHALLENGE - hex fractal]===
« Reply #11 on: March 20, 2018, 03:15:52 PM »
You guys are too quick! Do you get any work done during the day?  :2funny:  Here's a variation of the hexfractal that you can try that looks simpler but has its own problems to solve. This time draw the outside perimeter as normal but replace the white filled areas with white filled circles that just fit inside the normal jagged holes.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: ===[CHALLENGE - hex fractal]===
« Reply #12 on: March 20, 2018, 11:06:37 PM »
I have to say that there were lacks in my last posted code - formulas for p1 and p2 in both subs (odd) and (even) were wrong... Now updated code and checked for 6 iterations (5 hours on my slow PC) and it looked fine which means that now p1 and p2 are correct... BTW. DWG is ab 125 MB... But no such astonishing effect with fractals - even 4 iterations is enough to see it good like in my posted picture... Only its more dense - you have to zoom in and pan more...

Gilles's subs I haven't checked, but I guess they are fine...

Regards, M.R.
 8-)
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: ===[CHALLENGE - hex fractal]===
« Reply #13 on: March 21, 2018, 05:28:00 AM »
What OP wants in a scripting way.

Code - Auto/Visual Lisp: [Select]
  1. (defun c:hexfract (/ *error* l i c n a d)
  2.   (defun *error* (msg)
  3.     (and msg
  4.          (/= msg "Function cancelled")
  5.          (prompt (strcat "\nError: " msg))
  6.     )
  7.     (foreach v '(clayer cmdecho osmode)
  8.       (setvar v (eval v))
  9.       (set v nil)
  10.     )
  11.     (princ)
  12.   )
  13.   (foreach p '((clayer . "0") (cmdecho . 0) (osmode . 0))
  14.     (set (car p) (getvar (car p)))
  15.     (setvar (car p) (cdr p))
  16.   )
  17.   (if (and (setq i (getint "\nNumber of iterations: "))
  18.            (setq c (getpoint "\nCenter: "))
  19.       )
  20.     (progn
  21.       (setq n 1
  22.             a 0
  23.             d (sqrt 3)
  24.       )
  25.       (or (tblsearch "BLOCK" "hex0")
  26.           (command-s "_.polygon" 6 c "_inscribe" (polar c (/ pi 2) 1))
  27.           (command-s "_.block" "hex0" c (entlast) "")
  28.       )
  29.       (repeat i
  30.         (if (not (tblsearch "BLOCK" (strcat "hex" (itoa n))))
  31.           (progn
  32.             (setq s (ssadd))
  33.             (command-s "_.zoom" "_window" (polar c (* pi 1.25) d) (polar c (* pi 0.25) d))
  34.             (repeat 6
  35.               (command-s "_.insert" (strcat "hex" (itoa (1- n))) (polar c a d) 1. 1. 0.)
  36.               (ssadd (entlast) s)
  37.               (setq a (+ a (/ pi 3)))
  38.             )
  39.             (command-s "_bhatch" "_properties" "solid" c "")
  40.             (ssadd (entlast) s)
  41.             (command-s "_.block" (strcat "hex" (itoa n)) c s "")
  42.           )
  43.         )
  44.         (setq n (1+ n)
  45.               a (+ a (atan (sqrt 3) 5))
  46.               d (* d (sqrt 7))
  47.         )
  48.       )
  49.       (command-s "_.insert" (strcat "hex" (itoa (1- n))) c 1. 1. 0.)
  50.       (command-s "_chprop" (entlast) "" "_layer" clayer "")
  51.       (command-s "_.zoom" "0.4x")
  52.     )
  53.   )
  54.   (*error* nil)
  55. )

Speaking English as a French Frog

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: ===[CHALLENGE - hex fractal]===
« Reply #14 on: March 23, 2018, 03:12:10 PM »
When I replace (command-s) with (vl-cmdf) on A2014 it works, but on A2017 it doesn't... Can you explain?
Thanks for your input... It works significantly faster with block command and insert.

M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube