[LISP程序]：贴个以前在001写的动态fillet倒角程序

梦断江南

2. 
   
3.   [FONT=courier new]
   
4. (princ "\n fd=======动态fillet 倒圆角------------lxx.2001.5ok")
   
5. (princ "\n支持line,arc,*polyline,circle--除了*polyline+*polyline ")
   
6. ;;用了grread;*error*
   
7. ;;esc中断处理;undo-mark /back恢复;支持键盘输入
   
8. ;;=============================================================
   
9. (defun c:fd (/ opdmode ep1 ep2 pt1 opt roop cenpt fr gr pt2 n na)
   
10. (princ "\n fd=======动态fillet 倒圆角-----undo/b-------雄啸lxx.2001.5ok")
    
11. (princ "\n支持line,arc,*polyline,circle--除了*polyline+*polyline ")
    
12. (setq opdmode (getvar "pdmode"))
    
13. (command "undo" "m" "cmdecho" "0" "blipmode" "off" "pdmode" "2")
    
14. (while (not(setq ep1 (entsel "\n点取第一条线:"))))
    
15. (while (not(setq ep2 (entsel "\n点取第二条线:"))))
    
16. (setq pt1 (cadr ep2)
    
17.       ;pt1 (getpoint "\nfillet 半径第一点:")
    
18.       opt pt1
    
19.       roop "true"
    
20.       fr (getvar "filletrad")
    
21. )
    
22. (princ "\n当前filletrad=")(princ fr)
    
23. (command "point" pt1 "filletrad" "");;; for undo
    
24. (setq cenpt (entlast))
    
25. (princ "\nfillet 半径第二点:")
    
26. (while roop
    
27.   (defun *error* (msg)(command "undo" "1" "erase" cenpt "")(princ "\n错误:")(princ msg)(setq *error* nil))
    
28.   (setq gr (grread t 7 0))
    
29.   (if (/= (car gr) 5)
    
30.     (setq roop nil)
    
31.     (if (not(equal (cadr gr) opt));;;else
    
32.      (progn
    
33.       (command "undo" "1")
    
34.       (setq pt2 (cadr gr)
    
35.             fr (distance pt1 pt2)
    
36.             opt pt2)
    
37.       (princ "\n当前filletrad=")(princ fr)
    
38.       (setvar "filletrad" fr)
    
39.       (command "fillet" ep1 ep2 ^c)
    
40.      );end progn
    
41.     );end if
    
42.   );end if
    
43. );end while
    
44. (setq *error* nil)
    
45. (if (= (car gr) 3);;;;;;;左键定filletrad
    
46.   (setq  pt2 (cadr gr)
    
47.          fr (distance pt1 pt2))
    
48. )
    
49. (if (and (= (car gr) 2)
    
50.          (and(< 47 (cadr gr))
    
51.              (> 58 (cadr gr))
    
52.     )    );;;0~9 ascii 码值48~57
    
53.     (setq n (chr(cadr gr))
    
54.           na (getstring (strcat "\n键盘输入:filletrad=" n))
    
55.           fr (atof (strcat n na))
    
56.     )
    
57. )
    
58. (princ "\n当前filletrad=")(princ fr)
    
59. (command "undo" "1")
    
60. (setvar "filletrad" fr)
    
61. (command "fillet" ep1 ep2 ^c "erase" cenpt "")
    
62. (setvar "pdmode" opdmode)
    
63. (princ)
    
64. )
    
65.   [/FONT]
    

<br />   [FONT=courier new]<br /> (princ "\n fd=======动态fillet 倒圆角------------lxx.2001.5ok")<br /> (princ "\n支持line,arc,*polyline,circle--除了*polyline+*polyline ")<br /> ;;用了grread;*error*<br /> ;;esc中断处理;undo-mark /back恢复;支持键盘输入<br /> ;;=============================================================<br /> (defun c:fd (/ opdmode ep1 ep2 pt1 opt roop cenpt fr gr pt2 n na)<br /> (princ "\n fd=======动态fillet 倒圆角-----undo/b-------雄啸lxx.2001.5ok")<br /> (princ "\n支持line,arc,*polyline,circle--除了*polyline+*polyline ")<br /> (setq opdmode (getvar "pdmode"))<br /> (command "undo" "m" "cmdecho" "0" "blipmode" "off" "pdmode" "2")<br /> (while (not(setq ep1 (entsel "\n点取第一条线:"))))<br /> (while (not(setq ep2 (entsel "\n点取第二条线:"))))<br /> (setq pt1 (cadr ep2)<br />       ;pt1 (getpoint "\nfillet 半径第一点:")<br />       opt pt1<br />       roop "true"<br />       fr (getvar "filletrad")<br /> )<br /> (princ "\n当前filletrad=")(princ fr)<br /> (command "point" pt1 "filletrad" "");;; for undo<br /> (setq cenpt (entlast))<br /> (princ "\nfillet 半径第二点:")<br /> (while roop<br />   (defun *error* (msg)(command "undo" "1" "erase" cenpt "")(princ "\n错误:")(princ msg)(setq *error* nil))<br />   (setq gr (grread t 7 0))<br />   (if (/= (car gr) 5)<br />     (setq roop nil)<br />     (if (not(equal (cadr gr) opt));;;else<br />      (progn<br />       (command "undo" "1")<br />       (setq pt2 (cadr gr)<br />             fr (distance pt1 pt2)<br />             opt pt2)<br />       (princ "\n当前filletrad=")(princ fr)<br />       (setvar "filletrad" fr)<br />       (command "fillet" ep1 ep2 ^c)<br />      );end progn<br />     );end if<br />   );end if<br /> );end while<br /> (setq *error* nil)<br /> (if (= (car gr) 3);;;;;;;左键定filletrad<br />   (setq  pt2 (cadr gr)<br />          fr (distance pt1 pt2))<br /> )<br /> (if (and (= (car gr) 2)<br />          (and(< 47 (cadr gr))<br />              (> 58 (cadr gr))<br />     )    );;;0~9 ascii 码值48~57<br />     (setq n (chr(cadr gr))<br />           na (getstring (strcat "\n键盘输入:filletrad=" n))<br />           fr (atof (strcat n na))<br />     )<br /> )<br /> (princ "\n当前filletrad=")(princ fr)<br /> (command "undo" "1")<br /> (setvar "filletrad" fr)<br /> (command "fillet" ep1 ep2 ^c "erase" cenpt "")<br /> (setvar "pdmode" opdmode)<br /> (princ)<br /> )<br />   [/FONT]<br />

梦断江南

演示
抱歉，动态过程无法捕捉