分形图形(树，图案)及螺旋型星云线的绘制

lcw0002003

好漂卤
真强，实在是高手

它山之石

最初由 snoopychen 发布
[B]还记得小时候玩过的一种玩具么？一个塑料板上有带内齿轮大圆形，一系列上面带有孔的小齿轮，把铅笔套在小齿轮的孔上，让小齿轮沿着大内齿轮滚动，于是，笔画出了一道漂亮的曲线。不大记得这种玩具叫什么名字了，好像... [/B]

曾经想了很久　
在CAD中画出这些漂亮的图形出来
只是数学没学好

这个真的很有意思。。。

highflybird

我也来一个:
这些天在做解方程的lisp程序是想起了牛顿分形，于是心血来潮，用lisp程序编写了一个牛顿分形。
用法加载程序，运行NT ,然后选择三种不同的颜色，这样大概两分钟内(视机器性能)一个牛顿分形就画好了。
用你的颜色把这个图可以搞得更漂亮！
[php]
;;;************
;;;牛顿迭代分形
;;;************
(defun C:Nt (/ con eps nx ny x y k cm newx newy OLDCMD oldsnap t0 col1 col2 col3)
  (setq OLDCMD (getvar "CMDECHO"))
  (setq oldsnap (getvar "OSMODE"))
  (princ "\n请选择三种不同的颜色:")
  (princ "\n选择颜色1:\n")
  (setq col1 (acad_colordlg 1))
  (princ "\n选择颜色2:\n")
  (setq col2 (acad_colordlg 3))
  (princ "\n选择颜色3:\n")
  (setq col3 (acad_colordlg 5))
  (if (not (and col1 col2 col3))
    (exit)
  )  
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
  (setq CON (/ (sqrt 3.0) 2))
  (setq EPS (/ 1.0 30))
  (setq t0 (getvar "TDUSRTIMER"))
  (setq nx -160)
  (repeat 320
    (setq ny -160)
    (repeat 320
      (setq x (/ nx 80.0))
      (setq y (/ ny 80.0))
      (setq k 1)
      (repeat 30
        (if (/= (dist x y) 0)
          (setq        cm   (* 3 (dist x y) (dist x y))
                newx (+ (* 2 x (/ 1.0 3)) (/ (- (* x x) (* y y)) cm))
                newy (- (* 2 y (/ 1.0 3)) (/ (* 2 x y) cm))
                x    newx
                y    newy
          )
        )
        (setq k (1+ k))
      )
      (cond
        ( (< (dist (1- x) y) EPS)
          (putpixel (+ nx 200) (- 200 ny) col1)
        )
        ( (< (dist (+ x 0.5) (- y con)) EPS)
          (putpixel (+ nx 200) (- 200 ny) col2)
        )
        ( (< (dist (+ x 0.5) (+ y con)) EPS)
          (putpixel (+ nx 200) (- 200 ny) col3)
        )
      )
      (setq ny (1+ ny))
    )
    (setq nx (1+ nx))
  )
  (princ "\n画牛顿分形用时")
  (princ (* (- (getvar "TDUSRTIMER") t0) 86400))
  (princ "秒")
  (command ".ZOOM" "E")
  (setvar "OSMODE" oldsnap)
  (setvar "CMDECHO" OLDCMD)
  (gc)
  (princ)
)
;;距离平方函数
(defun dist (a b)
  (+ (* a a) (* b b))
)
;;画像素点函数
(defun putpixel (a b c)
  (entmake
    (list
      '(0 . "LWPOLYLINE")   
      '(100 . "AcDbEntity")
      '(100 . "AcDbPolyline")
      '(90 . 2)
      '(43 . 1.0)
      (cons 62 c)
      (cons 10 (list a b))
      (cons 10 (list (1+ a) b))
    )
  )
)
(defun putpixel1 (a b c)
  (entmake
    (list
      '(0 . "POINT")
      (cons 10 (list a b 0))
      (cons 62 c)
    )
  )
)
[/php]

不能发图片上来，请大家看看到这个网址去看效果：
http://www.mjtd.com/BBS/dispbbs.asp?boardid=3&id=58371
http://www.abbs.com.cn/bbs/post/ ... amp;tpg=1&age=0

今天又做了一个芒德勃罗分形：
这次用到了真彩色，显得颜色更丰富了。
命令：MD ,然后选择三种颜色，在一两分钟后就可以看到效果了。
下面是源程序，需要2004以上版本支持（因为只有这个版本以上才支持真彩色）

[php]
;;;==========================
;;;用CAD画Mandelbrot的主程序.
;;;highflybird 2007/03/05.KM.
;;;==========================
(prompt "\n请输入命令MD")
(defun C:MD (/ c1 c2 c3 repmin repmax impmin impmax Thre ita sol)
  (vl-load-com)
  (princ "\n请选择三种不同的颜色:")
  (princ "\n选择颜色1:\n")
  (setq c1 (acad_colordlg 10))
  (princ "\n选择颜色2:\n")
  (setq c2 (acad_colordlg 70))
  (princ "\n选择颜色3:\n")
  (setq c3 (acad_colordlg 150))
  (if (and c1 c2 c3)
    (progn
      (setq repmin -2.25 repmax 0.75);左右边界
      (setq impmin -1.5 impmax 1.5)  ;上下边界
      (setq Thre 10)                 ;阈值
      (setq ita 255)                 ;最大迭代次数
      (setq sol 512)                 ;分辨率
      (setq t0 (getvar "TDUSRTIMER"));开始计时
      (Mandelbrot C1 C2 C3 sol repmin repmax impmin impmax Thre ita)
      (princ "\n画分形用时")
      (princ (* (- (getvar "TDUSRTIMER") t0) 86400))
      (princ "秒")
      (command ".zoom" '(0 0) (list sol sol))
    )
    (alert "你没有选择颜色!")
  )  
  (gc)
  (princ)
)
;;;==========================
;;;Mandelbrot算法函数(带参数)
;;;==========================
(defun Mandelbrot (C1 C2 C3 sol repmin repmax impmin impmax Thre ita /
                   CCC dx dy i j rePart imPart rez imz ntimes absZ
                   TmpReZ TmpImZ Col0 ColR ColG colB ncolor)
  (setq CCC (* 256 256))
  (setq dx (/ (- repmax rePmin) sol))
  (setq dy (/ (- impmax imPmin) sol))
  (setq i 0)
  (repeat sol
    (setq j 0)
    (repeat sol
      (setq rePart (+ repmin (* i dx)))
      (setq imPart (+ impmin (* j dy)))
      (setq reZ 0 imZ 0)
      (setq nTimes 0)
      (while (<= ntimes ita)
        (setq TmpReZ (+ (* reZ reZ) (* imZ imZ -1) rePart))
        (setq TmpImZ (+ (* 2 reZ imZ) imPart))
        (setq absZ (dist TmpReZ TmpImZ))
        (if (> absZ Thre)
          (progn
            (setq col0 (* 7 ntimes))
            (setq colR (rem (+ c1 col0) 256))
            (setq colG (rem (+ c2 col0) 256))
            (setq colB (rem (+ c3 col0) 256))
            (setq colG (* colG 256))
            (setq colR (* colR ccc))
            (setq ncolor (+ colR colG colB))
            (putpixel i j ncolor)
            (setq ntimes ita)
          )
          (setq rez TmpReZ imz TmpImZ)   
        )
        (setq nTimes (1+ nTimes))
      )
      (setq j (1+ j))
    )
    (setq i (1+ i))
  )
)
;;;==========================
;;;距离平方函数每次迭代需要  
;;;==========================
(defun dist (a b)
  (+ (* a a) (* b b))
)
;;;==========================
;;;用entmake方法画像素点函数
;;;==========================
(defun putpixel (a b c)
  (entmake
    (list
      '(0 . "LWPOLYLINE")   
      '(100 . "AcDbEntity")
      '(100 . "AcDbPolyline")
      '(90 . 2)
      '(43 . 1.0)
      (cons 420 c)
      ;;(cons 62 c)
      (cons 10 (list a b))
      (cons 10 (list (1+ a) b))
    )
  )
)
;;;==========================
;;;另一种算法               
;;;==========================
(defun C:MmD ()
  (setq l 4)
  (setq dx (/ 3.0 640))
  (setq        dy (/ 2.2 480))
  (setq i 0)
  (repeat 640
    (setq cx (+ -1.9 (* i dx)))
    (setq j 0)
    (repeat 480
      (setq cy (+ -1.2 (* j dy)))
      (setq y 0 x y)
      (setq n 0)
      (repeat 200
        (setq x_n (+ (* x x) (* y y -1) cx))
        (setq y_n (+ (* 2 x y) cy))
        (setq m (* x_n x_n))
        (if (<= m l)
          (setq x x_n y y_n)
        )
        (setq n (1+ n))
      )
      (putpixel i j (fix (rem (* 0.4 m) 255)))
      (setq j (1+ j))
    )
    (setq i (1+ i))
  )
)
[/php]
过些天我把用对话框控制分形参数的lisp传上来。

snoopychen

:) highflybird兄，谢谢分享代码，图形很漂亮，可以也转贴到这里么？

等我下载回来再好好学习了。

highflybird

不好意思，我无法上传图片，也不知道怎么转贴，所以只能引用网址了。
http://www.mjtd.com/BBS/dispbbs. ... ID=58371&page=1
这个里面有我做的牛顿分形，曼式分形，朱氏分形的图片，你可以看看。

终于可以上传图片了：

                               
登录/注册后可看大图

-----------这幅图我取名叫《蚀》

                               
登录/注册后可看大图

-----------这幅图我取名叫《潮》

                               
登录/注册后可看大图

                               
登录/注册后可看大图

它山之石

因为儿子喜欢画着玩
又想起了qjchen 写的这个
今天搜索了下
找到个完整的原理及公式的网页


http://xubeisi.spaces.live.com/blog/cns!21025694565D1417!268.entry
这里还有一个小程序
有兴趣的可以下来看看


[iframe h=600 w=100%]http://www.hlps.hc.edu.tw/elon/paper/spirograph.htm[/iframe]

snoopychen

:),  原来石兄的儿子已经会挥毫作画了，好小伙啊。

一周前刚生了个男孩，最近忙的不可开交了。

当时用的原理是自己想的，应该和石兄之文类似。后来其实想把它编成不规则（非圆形）封闭图形内一点绕另一不规则封闭线滚动，看其轨迹，思路早已想好，没有精力下手去编制，以后有空再添加了。

queqeu

这种语言可以变成VC++语言吗？没学过这种语言，看不懂啊~！