xazhji的动画很有意思。不过....
你能否做个正常退出的控制 ？比如用回车键或鼠标左键。
其必要性在于：这是正规的做法；用ESC键是不可靠的，你也许要按30次才能进入控制圈。
还有，这会为如何解决此类问题提供重要的方法。
daziran发表于2003-7-24 15:47:00static/image/common/back.gifxazhji的动画很有意思。不过....
你能否做个正常退出的控制 ？比如用回车键或鼠标左键。
其必要性在于：这是正规的做法；用ESC键是不可靠的，你也许要按30次才能进入控制圈。
其实，我是这样认为的，作为一个娱乐程序，本身没有什么实用价值，况且，我这几个程序，都是死循环，在lisp中，好像你要读某个设备输入的值，它就要等待，程序也就暂停等候，要是这样设置的话，如果要不停的让它动作起来，就要按着一个键不放手，这样，反而不好，倒不如一键退出方便。
应该多挖掘新用途，也许会成崭新的分支，死循环的确不是好办法。
本帖最后由 作者 于 2003-7-29 9:09:24 编辑
也许，复杂的图形让你感到头晕目眩，怎样“玩转”它？也许，这个程序对你有用。
运行时，必须绘图环境中有东西哟，不然可没有效果，越复杂的图形，可能眩晕的效果越好。
★★强烈建议运行程序前，保存你的文件，否则后果自负！！！
;;16:25 2003-7-28 疯狂图形
;;;;by xazhji
(defun c:fktx()
(setvar "cmdecho" 0)
(setq vcen (getvar "viewctr"))
(setq angg 0.05)
(while t
(command "rotate" "all" "" vcen angg)
(setq angg (+ angg 0.05))
)
)
(princ "\n成功调入《疯狂图形》!键入 fktx 运行......")(prin1)
;看看这个，鼠标右键退出
(vlr-mouse-Reactor nil '((:VLR-beginRightClick . quits)))
(defun quits (calling-reactor commandInfo / dwgname filesize)
(vl-load-com)
(setq m nil)
(princ)
)
(defun c:fg( / dang p1 p2 ang p3 str sname)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(command "zoom" "w" "0,62" "200,-58")
(command "line" "-60,0" "260,0" "")
(setq str '((0 . "LINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model")
(8 . "center") (100 . "AcDbLine") (10 0.0 0.0 0.0)
(11 0.0 10.0 0.0) (210 0.0 0.0 1.0)))
(entmake str)
(setq sname (entlast))
(setq dang (/ pi 180) ang (- (/ pi 2) dang))
(setq p1 (list 0 0) p2 (polar p1 ang 10))
(setq m t)
(while m
;(if (<= ang 0) (progn (setq p3 p2 p2 p1 p1 p3 ang pi)(princ "p1==>" )(princ p1 )(princ "p2==>" )(princ p2)))
(if (and (> dang 0)(<= ang 0)) (setq p3 (polar p1 0 10) p1 p3 p2 (polar p1 pi 10) ang pi))
(if (and (< dang 0)(>= ang pi)) (setq p3 (polar p1 pi 10) p1 p3 p2 (polar p1 0 10) ang 0))
(setq str (entget sname))
(setq str (subst (cons 10 p1) (assoc 10 str) str))
(setq str (subst (cons 11 p2) (assoc 11 str) str))
(entmod str)
(redraw)
(setq sname (entlast))
(setq ang (- ang dang))
(setq p2 (polar p1 ang 10))
(if (or (>= 0 (car p2))(<= 200 (car p2)))(setq p1 p2 p2 (polar p1 (/ pi 2) 10) dang (* dang -1) ang (/ pi 2)))
)
)
(princ "\n成功调入!键入 fg 运行......")(prin1)
不行呀，左右键都不行，我测试过了。
我这2004，测试没问题。成功退出。
对了，好象应该先加载(vl-load-com)
不行，还是不行，我用2000，2004，一样。
另外，我认为(vlr-mouse-Reactor nil '((:VLR-beginRightClick . quits)))一句应该在调用 (vl-load-com)之后，否则，调用出错。我也调整了，结果，一样，无效！