请高手帮忙修改下程序
这是一个由Zm184几年前编写的一个改进过的半径为0倒圆角的程序，可实线框选条件下的相互剪切，非常好用，用了几年了，感觉美中不足的是当二条线或多条线均为多义线时，功能就实效了，不能倒角了，请高手帮忙修改下，谢谢了！;;功能：对系统提供的 圆角 命令的改进
;;日期：zml84 于 2007-08-04 17:00
(defun C:SSS (/ *ERROR* *MYERR* CMD_OLD OS_OLD*OLDERR*
TEST0 TEST TMP TMP2 INT PT1 PT2
SS A B
)
(princ "\n")
;;============================
(defun *MYERR* (MSG)
(setvar "CMDECHO" CMD_OLD)
(setvar "OSMODE" OS_OLD)
(setq *ERROR* *OLDERR*)
(if (= MSG "")
(princ (strcat "\n>>>" MSG))
(princ "\n")
)
(princ)
)
(setq *OLDERR* *ERROR*
*ERROR**MYERR*
OS_OLD (getvar "OSMODE")
CMD_OLD(getvar "CMDECHO")
)
;;==============================
;;1、系统变量设置
(setvar "OSMODE" 0)
(setvar "CMDECHO" 0)
;;显示选项当前值
(princ
(strcat
"\n当前设置: 模式 = "
(nth (getvar "TRIMMODE") '("不修剪" "修剪"))
"，半径 = "
(rtos (getvar "FILLETRAD") 2 4)
)
)
;;2、循环连续执行
(setq TEST0 t)
(while TEST0
;;初始化
(setq A NIL
B NIL
)
;;2.1、选择对象1
(princ "\n选择对象或 [多段线(P)/半径(R)/修剪(T)]: ")
(setq TEST t)
(while TEST
(setq TMP (grread t 4 2))
(cond
;;按下键盘键
((= (car TMP) 2)
(setq INT (cadr TMP))
(cond
;;回车或者空格键，则退出
((or (= INT 13)
(= INT 32)
)
(setq TEST NIL
TEST0 NIL
)
)
;;P选项
((or (= (ascii "P") INT)
(= (ascii "p") INT)
)
(if (and (setq SS (entsel " >>选择二维多段线: "))
(= (cdr (assoc 0 (entget (car SS))))
"LWPOLYLINE"
)
)
(command "_.fillet" "P" SS)
)
)
;;R选项
((or (= (ascii "R") INT)
(= (ascii "r") INT)
)
(princ (strcat "\n>>指定圆角半径 <"
(rtos (getvar "FILLETRAD") 2 2)
">: "
)
)
(if (setq TMP2 (getdist))
(setvar "FILLETRAD" TMP2)
)
)
;;T选项
((or (= (ascii "T") INT)
(= (ascii "t") INT)
)
(initget "T N")
(setq TMP2
(getkword
(strcat
"\n>>输入修剪模式选项 [修剪(T)/不修剪(N)] <"
(nth (getvar "TRIMMODE")
'("不修剪" "修剪")
)
">: "
)
)
)
(if (= TMP2 "T")
(setvar "TRIMMODE" 1)
(if (= TMP2 "N")
(setvar "TRIMMODE" 0)
)
)
)
)
(princ "\n选择对象或 [多段线(P)/半径(R)/修剪(T)]: ")
)
;;击鼠标右键
((= (car TMP) 12)
(setq TEST NIL
TEST0 NIL
)
)
;;击左键
((= (car TMP) 3)
(setq PT1 (cadr TMP))
(if (setq SS (ssget PT1))
(setq A (list (ssname SS 0) PT1)
TEST NIL
)
(if (and
(setq PT2 (getcorner PT1 " >>>第二点:"))
(setq SS (ssget "c" PT1 PT2))
)
(progn
(setq A (list (ssname SS 0) (MID PT1 PT2))
TEST NIL
)
(if (>= (sslength SS) 2)
(setq B (list (ssname SS 1)
(MID PT1 PT2)
)
)
)
)
(princ
"\n选择对象或 [多段线(P)/半径(R)/修剪(T)]: "
)
)
)
)
) ;_ 结束 cond
) ;_ 结束 while
(if (and A
(not (redraw (car A) 3))
(= B NIL)
)
(progn
;;2.2、选择对象2
(princ "\n选择对象:")
(setq TEST t)
(while TEST
(setq TMP (grread t 4 2))
;;(if (setq PT1 (getpoint "\n选择对象:"))
(cond
;;击左键
((= (car TMP) 3)
(setq PT1 (cadr TMP))
(if (setq SS (ssget PT1))
(setq B (list (ssname SS 0) PT1)
TEST NIL
)
(if (and
(setq
PT2 (getcorner PT1
" >>>第二点:"
)
)
(setq SS (ssget "c" PT1 PT2))
)
(setq B (list (ssname SS 0)
(MID PT1 PT2)
)
TEST NIL
)
(princ "\n选择对象:")
)
)
)
;;击右键
((= (car TMP) 12)
(setq TEST NIL)
)
) ;_结束 cond
)
)
) ;_结束 if
;;圆角操作
(if (and A B)
(command "_.fillet" A B)
)
(if A
(redraw (car A) 4)
)
)
;;3、恢复系统变量设置
;;============
(*ERROR* "完美退出。谢谢使用。")
;;============
(princ)
) ;_结束 defun
页:
[1]