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));;提取刚划的线

)