grread lisp 橡皮筋_晓东CAD家园-论坛-A/VLISP-[LISP程序]:grread模拟橡皮筋-这个程序是自己写的grread模拟橡皮筋,但没能达到预想效果,请高手改错,谢谢,测试请用...

哈哈,自己改好了,请测验,代码如下:

;;luyu 9635 2009.08.20

;;用grread模拟橡皮筋

;;按数字5转换正交

(defun grread-pt (po / gr pa pd pt ang)

(princ "\n正交转换请按5:")

(setq        ennext nil z t)

(if (= nil f8)(setq f8 0))

(while z

(initget 128)

(setq gr (grread t 4 3))

(setq pa (car gr) pd (cadr gr))

(cond ((= 5 (car  gr))        ;;如果鼠标在移动

(cond ((= f8 0)

(setq ang (atoi (angtos (angle po pd))))

(if(> ang 315)(setq ang (- 360 ang)))

(cond ((and (< ang 45) (> ang -45))

(setq pt (list (car pd) (cadr po) 0))

)

((and (< ang 135) (> ang 45))

(setq pt (list (car po) (cadr pd) 0))

)

((and (< ang 225) (> ang 135))

(setq pt (list (car pd) (cadr po) 0))

)

((and (< ang 315) (> ang 225))

(setq pt (list (car po) (cadr pd) 0))

)

)

)

((= f8 1)(setq pt pd))

)

(entmakeline)

)

((= 2 pa)

(if (= 5 (read(chr pd)));设定数字5为正交开关

(if (= f8 0);转换状态

(progn

(setq f8 1 pt (cadr (grread 1)))

(entmakeline)

)

(setq f8 0)

)

)

)

((= pa 3)(setq z nil));;如果左击了退出

(t  (setq  z nil))

)

)

(princ)

)

;;;

(defun entmakeline()

(if ennext (entdel ennext));;删除上次画的线

(entmake (list '(0 . "line") '(62 . 7) (cons 10 po) (cons 11 pt)));;划线

(setq ennext (entlast));;提取刚划的线

)

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值