分形播放乐筑天下 - Powered by Discuz! Archiver

fuccaro 发表于 2022-7-5 16:53:43

分形播放

第一个Lisp只是一个经典示例：
(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)
)

它使用递归绘制越来越多的线，形成越来越小的三角形。当要绘制的线变小为0.1个绘制单位时，它停止。我自己也想知道这个程序有多短——这证明了Lisp的强大。

第二个程序：我开始的时候脑海里有一个折线符号。这次我放弃了递归，用户可以控制递归的深度。它从一条线开始，在树上断开。第一行保留作为参考（绿色的一行），程序每次运行都会打断在上一步生成的所有行。有一个声明为全局变量的列表，用于在程序运行之间保存数据。如何使用：加载程序并首先运行。之后可能需要缩放。再运行一次程序，再运行一次…只需按空格键即可进入下一个级别。
(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)
)

我认为在两次运行之间保留行列表不是一个好做法，因此这里是第三个lisp。它画了一条线，但实际上是一个块。与上一个程序一样，使用它可以在图形中插入越来越多的块。也许你会问为什么我只用一个方块来画一条简单的线。嗯，在我得到第一个图像后，我简单地编辑了块，AutoCAD将我发布在这里的内容作为下一个图像返回。（我手动将第一个块更改为绿色，只是为了更好地显示我的意思）。
(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))
         )
   )
)
)

最后一个Lisp用于在三维中移动。运行一次。如果需要，对模型进行着色（线框看起来不太好看），缩放和动态观察以捕捉良好的角度。现在一次又一次地运行程序……直到你的电脑自动挂断。

(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)))
)

Lee Mac 发表于 2022-7-5 17:01:14

干得好Fuccaro！真的很有趣

你可能也对这个和这个感兴趣

李

fuccaro 发表于 2022-7-5 17:04:32

谢谢你，李。我以前见过那些大师级的职位。这是我的业余尝试。

Lee Mac 发表于 2022-7-5 17:05:15

谢谢Fuccaro，但你的帖子一点也不业余——你的3D Sierpinski三角形令人印象深刻

Steven Erickson 发表于 2022-7-5 17:11:34

李-我查看了你在这个帖子中附加的链接，它们确实令人印象深刻。我想知道你是否浏览过保罗·尼兰德的网站。里面塞满了有趣的东西。他似乎用mathematica生成分形。http://bugman123.com/index.html

Lee Mac 发表于 2022-7-5 17:15:22

真的很好！谢谢Steven

忘了也包括这条线-数学的另一个有趣的领域

fuccaro 发表于 2022-7-5 17:17:55

你好
我找到了我的旧玩具，又Lisp程序了。我使用了相同的程序，并做了一些小改动，以获得这些图像：
https://www.cadtutor.net/forum/attachment.php?attachmentid=56937&cid=1&stc=1https://www.cadtutor.net/forum/attachment.php?attachmentid=56935&cid=1&stc=1https://www.cadtutor.net/forum/attachment.php?attachmentid=56934&cid=1&stc=1
以下是程序：
(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))
   ))
)

以及即将到来的情人节的特殊变化：
https://www.cadtutor.net/forum/attachment.php?attachmentid=56941&cid=1&stc=1
这是最后一个图像的程序：
(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))
   ))
)

CAD USER 发表于 2022-7-5 17:23:02

很不错的。。。。。坚持下去。。。。

fuccaro 发表于 2022-7-5 17:27:30

大家好！
我有一些时间，所以我为这个Julia集写了一个Lisp。我不能上传这里的动画gif，所以这里有一些图像在放大。
https://www.cadtutor.net/forum/attachment.php?attachmentid=57608&cid=1&stc=1https://www.cadtutor.net/forum/attachment.php?attachmentid=57609&cid=1&stc=1https://www.cadtutor.net/forum/attachment.php?attachmentid=57610&cid=1&stc=1https://www.cadtutor.net/forum/attachment.php?attachmentid=57611&cid=1&stc=1https://www.cadtutor.net/forum/attachment.php?attachmentid=57612&cid=1&stc=1https://www.cadtutor.net/forum/attachment.php?attachmentid=57613&cid=1&stc=1https://www.cadtutor.net/forum/attachment.php?attachmentid=57614&cid=1&stc=1https://www.cadtutor.net/forum/attachment.php?attachmentid=57615&cid=1&stc=1

Lee Mac 发表于 2022-7-5 17:29:49

干得好fuccaro！

你用什么物体来显示分形？

（我使用点对象来形成图像，缩放比例为每像素一个点）

页: [1] 2

乐筑天下's Archiver

分形播放