分形播放

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的强大。

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

copy

(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将我发布在这里的内容作为下一个图像返回。（我手动将第一个块更改为绿色，只是为了更好地显示我的意思）。

copy

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

copy

(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程序了。我使用了相同的程序，并做了一些小改动，以获得这些图像：

登录/注册后可看大图

以下是程序：

copy

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

以及即将到来的情人节的特殊变化：

登录/注册后可看大图

这是最后一个图像的程序：

copy

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