明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 4146|回复: 19

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

  [复制链接]
发表于 2011-5-2 12:25 | 显示全部楼层 |阅读模式
本帖最后由 ProgramFancier 于 2011-5-2 20:29 编辑

偶然在网上找到一个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)
)
)
)



本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x

评分

参与人数 2金钱 +30 收起 理由
raimo + 10 好程序,漂亮!其他正多边形呢
highflybird + 20 在程序中找到美,确实是一件好事。

查看全部评分

发表于 2011-5-2 12:38 | 显示全部楼层
漂亮,呵呵楼主雅人啊
发表于 2011-5-2 12:41 | 显示全部楼层
不错,赞一个
发表于 2011-5-2 17:34 | 显示全部楼层
本帖最后由 qjchen 于 2011-5-2 18:12 编辑

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

这个程序的出处,应该是 李学志 编写的
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”
唉,不小心就找到电子书了...查了一下,代码确实如上




发表于 2011-5-2 18:15 | 显示全部楼层
楼上真有心
发表于 2011-5-2 18:15 | 显示全部楼层
感谢楼主分享学习!
发表于 2011-5-2 18:40 | 显示全部楼层
本帖最后由 highflybird 于 2011-5-2 18:44 编辑
qjchen 发表于 2011-5-2 17:34
欢迎楼主到明经,发表更多美丽的帖子

这个程序的出处,应该是 李学志 编写的
感谢QJchen的搜索,
其实这本书我买了的,今天翻开一看,果然是的,原程序在74页。

稍微修改了一下,实现了动态的效果:




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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
 楼主| 发表于 2011-5-2 19:08 | 显示全部楼层
回复 qjchen 的帖子

有心人啊,其实我也有那本书pdf版,只是有一本纸质 机械工业版Lisp教程,所以没怎么看那本书。
 楼主| 发表于 2011-5-2 19:10 | 显示全部楼层
回复 highflybird 的帖子

谢谢了,对cad二次开发我还知道的不多,相互学习。
 楼主| 发表于 2011-5-2 20:40 | 显示全部楼层
回复 highflybird 的帖子

很不错啊,又有新花样了,学习了。递归之美,美在优美与简洁。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号  
©2000-2020 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2021-6-16 06:08 , Processed in 0.679506 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表