递归之美——旋转的正多边形

ProgramFancier

偶然在网上找到一个Lisp写的旋转正六边形的代码，简单几行代码就实现了颇具视觉效果的图形，递归算法真是神奇呀！经过一番仔细研究，耍出更多花样，赋予黑白线条256种不同颜色，还发现任意边数正多边形都可以“旋转”，并重写了直线绘制函数。唯递归经典不变。

样图：



多彩旋转正六边形


旋转的正三角形



dwg图形：



原作代码：
;by: 李学志 "Visaul LISP 程序设计(AutoCAD 2006)"
(defun c:xzl( / pc lmax lmin alf )
  (setvar "cmdecho" 0) ;关闭普通命令提示信息
  (setvar "blipmode" 0) ;关闭光标痕迹
  (setvar "osmode" 0) ;关闭对象捕捉状态
  (setq pc(getpoint "\n输入正六边形的旋转中心:"))
  (setq lmax(getdist pc "\n输入正六边形的最大边长:"))
  (setq lmin(getdist pc "\n输入正六边形的最小边长:"))
  (setq alf(getangle pc "\n输入正六边形的旋转角:"))
  (hexagon pc lmax lmin 0.0) ;调用递归方式绘制旋转正六边形的函数
  (princ) ;静默退出
)
(defun hexagon (pc l lmin phi ) ;变元phi是正六边形的初始角度
  (command "pline" (polar pc phi l)
                 (polar pc (+ phi (/ pi 3.0 )) l)
                 (polar pc (+ phi (/ pi 1.5 )) l)
                 (polar pc (+ phi pi) l)
                 (polar pc (+ phi (/ pi 0.75)) l)
                 (polar pc (+ phi (/ pi 0.6 )) l)
                 "c"
  )
(if (>= l lmin)
   (progn
    (setq l(/ l (+ (cos alf) (* (sin alf) 0.5773503))));下一个正六边形的边长
    (setq phi (+ phi alf)) ;下一个正六边形的旋转角度
    (hexagon pc l lmin phi) ;绘制下一个正六边形
   )
)
)

本人修改后的代码：
; by: ProgramFancier  2011.5.1
(defun c:xzl( / pc lmax lmin alf )
  (setq pc(getpoint "\n输入正六边形的旋转中心:"))
  (setq lmax(getdist pc "\n输入正六边形的最大边长:"))
  (setq lmin(getdist pc "\n输入正六边形的最小边长:"))
  (setq alf(getangle pc "\n输入正六边形的旋转角:"))
  (hexagon pc lmax lmin 0.0) ;调用递归方式绘制旋转正六边形的函数
  (princ) ;静默退出
)
(setq col 0)
(defun hexagon (pc l lmin phi) ;变元phi是正六边形的初始角度
(if (<= col 255)
(setq col (+ col 1))
(setq col 0)
)
  (mklines (list (polar pc phi l)
                 (polar pc (+ phi (/ pi 3.0 )) l)
                 (polar pc (+ phi (/ pi 1.5 )) l)
                 (polar pc (+ phi pi) l)
                 (polar pc (+ phi (/ pi 0.75)) l)
                 (polar pc (+ phi (/ pi 0.6 )) l)
                 (polar pc (+ phi (/ pi 0.5 )) l)
  ) col)
(if (>= l lmin)
   (progn
    (setq l(/ l (+ (cos alf) (* (sin alf) 0.5773503))));下一个正六边形的边长
    (setq phi (+ phi alf)) ;下一个正六边形的旋转角度
    (hexagon pc l lmin phi) ;绘制下一个正六边形
   )
)
)
;***************************************
(defun mkLines(pt layer)
(setq len (length pt))
(setq n -1) ;初始值
(repeat (- len 1)
(setq n (+ n 1))
(setq pt1 (nth n pt))
(setq pt2 (nth (+ n 1) pt))
(mkLine pt1 pt2 layer)
)
)
;构造实体line函数
(defun mkLine(pt1 pt2 layer)
(entmake
(list
'(0 . "LINE")
'(100 . "AcDbEntity")
(cons 62 layer)
'(100 . "AcDbLine")
(cons 10 pt1)
(cons 11 pt2)
)
)
)

usercoolbo

漂亮，呵呵楼主雅人啊

highflybird

不错，赞一个

qjchen

欢迎楼主到明经，发表更多美丽的帖子

这个程序的出处，应该是 李学志 编写的
Visual LISP程序设计：AutoCAD 2006

中第七章的代码
http://www.dushu.com/book/11247249/

具体的搜索过程有点有趣，记录一下

刚才我以";变元phi是正六边形的初始角度" 这句话google搜索了一下
得到了 百度文库的文章
http://wenku.baidu.com/view/6428edc5bb4cf7ec4afed018.html

觉得是 清华大学出版社出版的
于是 到 www.dushu.com处，查询 lisp 清华大学出版社
得到几本书
发现 《Visual LISP程序设计：AutoCAD 2006》 一书的目录中
有 第七章  构造应用程序 类似百度文库的 目录
于是再次google一下 “Visual LISP程序设计：AutoCAD 2006”
唉，不小心就找到电子书了...查了一下，代码确实如上

masterlong

楼上真有心

yoyoho

感谢楼主分享学习!

highflybird

qjchen 发表于 2011-5-2 17:34
欢迎楼主到明经，发表更多美丽的帖子

这个程序的出处，应该是 李学志 编写的

感谢QJchen的搜索，
其实这本书我买了的，今天翻开一看，果然是的，原程序在74页。

稍微修改了一下，实现了动态的效果：




当然，这个程序也可以不用递归实现的。在对速度要求高的场合中中还是少用递归。

ProgramFancier

回复 qjchen 的帖子

有心人啊，其实我也有那本书pdf版，只是有一本纸质 机械工业版Lisp教程，所以没怎么看那本书。

ProgramFancier

回复 highflybird 的帖子

谢谢了，对cad二次开发我还知道的不多，相互学习。

ProgramFancier

回复 highflybird 的帖子

很不错啊，又有新花样了，学习了。递归之美，美在优美与简洁。