[分享]一个文字搜索替换程序

zshqd

2. (defun myerr (s)
   
3.         (if (/= s "Function cancelled")
   
4.                 (princ (strcat "\nError: " s))
   
5.         )
   
6.         (setq tset nil)        ; Free selection set
   
7.         (setq *error* olderr)
   
8.         (princ)
   
9. )
   
10. 
    
11. (defun C:texsrch (/ tset l n e os as ns st s nsl osl sl si chf chm olderr)
    
12. 
    
13.         (setq
    
14.                 olderr *error*
    
15.                 *error* myerr
    
16.                 chm 0
    
17.         )
    
18.         (menucmd "S=SELECT")
    
19.         (prompt "\nSelect Text To Modify <All>: ")
    
20.         (if (null (setq tset (ssget)))
    
21.                 (setq tset (ssget "x" (list (cons 0 "TEXT"))))
    
22.         )
    
23.         (menucmd "S=")
    
24.         (cond
    
25.                 ((null tset) (prompt "\nNo Text Located in Drawing."))
    
26.                 (t (terpri)
    
27.                         (princ (itoa (sslength tset)))
    
28.                         (prompt " Text Entities Selected.")
    
29.                         (command "undo" "mark")
    
30.                 )
    
31.         )
    
32.         (cond
    
33.                 ((null tset) (prompt "\nNothing Modified."))
    
34.                 (t
    
35.                         (while (= 0 (setq osl (strlen
    
36.                                 (setq os (getstring t "\nOld string: ")))))
    
37.                                 (princ "Null input invalid")
    
38.                         )
    
39.                         (setq nsl (strlen (setq ns (getstring t "\nNew string: "))))
    
40.                         (setq l 0 n (sslength tset))
    
41.                         (while (< l n)       
    
42.                                 (if (= "TEXT" (cdr (assoc 0 (setq e (entget (ssname tset l))))))
    
43.                                         (progn
    
44.                                                 (setq
    
45.                                                         chf nil
    
46.                                                         si 1
    
47.                                                         s (cdr (setq as (assoc 1 e)))
    
48.                                                 )
    
49.                                                 (while (= osl (setq sl (strlen
    
50.                                                         (setq st (substr s si osl)))))
    
51.                                                                 (if (= st os)
    
52.                                                                 (progn
    
53.                                                                         (setq s (strcat (substr s 1 (1- si)) ns
    
54.                                                                                 (substr s (+ si osl)
    
55.                                                                         )))
    
56.                                                                         (setq chf t)
    
57.                                                                         (setq si (+ si nsl))
    
58.                                                                 )
    
59.                                                                 (setq si (1+ si))
    
60.                                                         )
    
61.                                                 )
    
62.                                                 (if chf
    
63.                                                         (progn       
    
64.                                                                 (setq e (subst (cons 1 s) as e))
    
65.                                                                 (entmod e)
    
66.                                                                 (setq chm (1+ chm))
    
67.                                                         )
    
68.                                                 )
    
69.                                         )
    
70.                                 )
    
71.                                 (setq l (1+ l))
    
72.                         )
    
73.                         (princ "Changed ")       
    
74.                         (princ chm)
    
75.                         (prompt " text lines.")
    
76.                 )
    
77.         )
    
78.         (setq *error* olderr)
    
79.         (princ)
    
80. )
    

(defun myerr (s)<br />         (if (/= s "Function cancelled")<br />                 (princ (strcat "\nError: " s))<br />         )<br />         (setq tset nil)        ; Free selection set<br />         (setq *error* olderr)<br />         (princ)<br /> )<br /> <br /> (defun C:texsrch (/ tset l n e os as ns st s nsl osl sl si chf chm olderr)<br /> <br />         (setq<br />                 olderr *error*<br />                 *error* myerr<br />                 chm 0<br />         )<br />         (menucmd "S=SELECT")<br />         (prompt "\nSelect Text To Modify <All>: ")<br />         (if (null (setq tset (ssget)))<br />                 (setq tset (ssget "x" (list (cons 0 "TEXT"))))<br />         )<br />         (menucmd "S=")<br />         (cond<br />                 ((null tset) (prompt "\nNo Text Located in Drawing."))<br />                 (t (terpri)<br />                         (princ (itoa (sslength tset)))<br />                         (prompt " Text Entities Selected.")<br />                         (command "undo" "mark")<br />                 )<br />         )<br />         (cond<br />                 ((null tset) (prompt "\nNothing Modified."))<br />                 (t<br />                         (while (= 0 (setq osl (strlen <br />                                 (setq os (getstring t "\nOld string: ")))))<br />                                 (princ "Null input invalid")<br />                         )<br />                         (setq nsl (strlen (setq ns (getstring t "\nNew string: "))))<br />                         (setq l 0 n (sslength tset))<br />                         (while (< l n)        <br />                                 (if (= "TEXT" (cdr (assoc 0 (setq e (entget (ssname tset l))))))<br />                                         (progn<br />                                                 (setq<br />                                                         chf nil<br />                                                         si 1<br />                                                         s (cdr (setq as (assoc 1 e)))<br />                                                 )<br />                                                 (while (= osl (setq sl (strlen<br />                                                         (setq st (substr s si osl)))))<br />                                                                 (if (= st os)<br />                                                                 (progn<br />                                                                         (setq s (strcat (substr s 1 (1- si)) ns<br />                                                                                 (substr s (+ si osl)<br />                                                                         )))<br />                                                                         (setq chf t) <br />                                                                         (setq si (+ si nsl))<br />                                                                 )<br />                                                                 (setq si (1+ si))<br />                                                         )<br />                                                 )<br />                                                 (if chf<br />                                                         (progn        <br />                                                                 (setq e (subst (cons 1 s) as e))<br />                                                                 (entmod e)<br />                                                                 (setq chm (1+ chm))<br />                                                         )<br />                                                 )<br />                                         )<br />                                 )<br />                                 (setq l (1+ l))<br />                         )<br />                         (princ "Changed ")        <br />                         (princ chm)<br />                         (prompt " text lines.")<br />                 )<br />         )<br />         (setq *error* olderr)<br />         (princ)<br /> )<br />