根据文字内容和颜色删除选中文字的函数，求高手指点

ld_117

第一次写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)  )

ld_117

自己解决了。。。

ZZXXQQ

压缩一下

2. (defun C:zfpj (/ m all i t1 t2 t3 t4 t5 t6 t7 c1 r)
   
3. (setq m:err *error* *error* *merr*)
   
4. (setq tlst '("0 xAUy    " "     xAUy0" "0 xAUy0" "0 xADy    " "     xADy0"
   
5.               "0 xADy0" "     xAUy    " "     xADy    "))
   
6. (setq c1 253)
   
7. (prompt "选择图形")
   
8. (if (setq all (ssget '((0 . "*TEXT")))) (progn
   
9.   (repeat (setq i (sslength all))
   
10.    (setq ss (ssname all (setq i (1- i))))        
    
11.    (setq alldata (entget ss))
    
12.    (setq tcontent (cdr(assoc 1 alldata)))
    
13.    (setq tcolor (cdr(assoc 62 alldata)))
    
14.    (if (or (= tccolor c1) (member tcontent tlst)) (entdel ss))
    
15.   )
    
16. ))
    
17. (princ)
    
18. )
    

(defun C:zfpj (/ m all i t1 t2 t3 t4 t5 t6 t7 c1 r)<br /> (setq m:err *error* *error* *merr*)<br /> (setq tlst '("0 xAUy    " "     xAUy0" "0 xAUy0" "0 xADy    " "     xADy0"<br />               "0 xADy0" "     xAUy    " "     xADy    "))<br /> (setq c1 253)<br /> (prompt "选择图形")<br /> (if (setq all (ssget '((0 . "*TEXT")))) (progn<br />   (repeat (setq i (sslength all))<br />    (setq ss (ssname all (setq i (1- i))))        <br />    (setq alldata (entget ss))<br />    (setq tcontent (cdr(assoc 1 alldata))) <br />    (setq tcolor (cdr(assoc 62 alldata)))<br />    (if (or (= tccolor c1) (member tcontent tlst)) (entdel ss))<br />   )<br /> ))<br /> (princ)<br /> )<br />

ld_117

ZZXXQQ 发表于 2014-7-21 20:38
压缩一下

多谢，最近燃起了研究这个的热情，我会坚持的