根据文字内容和颜色删除选中文字的函数，求高手指点
本帖最后由 ld_117 于 2014-7-21 15:52 编辑第一次写lisp程序，函数功能很简单，试了好久功能终于实现了，但有些bug。执行完函数后删除了很多文字想要取消前一个操作，得一直undo才行，怎样才能一次undo就恢复要执行函数前的状态呢？？
(defun C:zfpj (/ m all i t1 t2 t3 t4 t5 t6 t7 c1 r) (setq m:err *error* *error* *merr*)
(setq t1 "0 xAUy ")
(setq t2 " xAUy0")
(setq t3 "0 xAUy0")
(setq t4 "0 xADy ")
(setq t5 " xADy0")
(setq t6 "0 xADy0")
(setq t7 " xAUy ")
(setq t8 " xADy ")
(setq c1 253)
(setq i 0)
(prompt "选择图形")
(setq all (ssget '((0 . "TEXT,MTEXT"))))
(while (< i (sslength all))
(setq r 1)
(setq ss (ssname all i))
(setq i (1+ i))
(setq alldata (entget ss))
(setq tcontent (cdr (assoc 1 alldata)))
(setq tcolor (cdr (assoc 62 alldata)))
(if (= tcolor c1) (setq r 2))
(if (= tcontent t1) (setq r 2))
(if (= tcontent t2) (setq r 2))
(if (= tcontent t3) (setq r 2))
(if (= tcontent t4) (setq r 2))
(if (= tcontent t5) (setq r 2))
(if (= tcontent t6) (setq r 2))
(if (= tcontent t7) (setq r 2))
(if (= tcontent t8) (setq r 2))
(if (= r 2) (command "erase" ss ""))
)
(command "UNDO" "E")
(princ))
自己解决了。。。 压缩一下(defun C:zfpj (/ m all i t1 t2 t3 t4 t5 t6 t7 c1 r)
(setq m:err *error* *error* *merr*)
(setq tlst '("0 xAUy " " xAUy0" "0 xAUy0" "0 xADy " " xADy0"
"0 xADy0" " xAUy " " xADy "))
(setq c1 253)
(prompt "选择图形")
(if (setq all (ssget '((0 . "*TEXT")))) (progn
(repeat (setq i (sslength all))
(setq ss (ssname all (setq i (1- i))))
(setq alldata (entget ss))
(setq tcontent (cdr(assoc 1 alldata)))
(setq tcolor (cdr(assoc 62 alldata)))
(if (or (= tccolor c1) (member tcontent tlst)) (entdel ss))
)
))
(princ)
)
ZZXXQQ 发表于 2014-7-21 20:38 static/image/common/back.gif
压缩一下
多谢，最近燃起了研究这个的热情，我会坚持的
页:
[1]