[LISP程序]：文字串搜索替换

hqd9639

2. 
   
3.   [FONT=courier new]
   
4. (defun myerr (s)
   
5.         (if (/= s "Function cancelled")
   
6.                 (princ (strcat "\nError: " s))
   
7.         )
   
8.         (setq tset nil)       
   
9.         (setq *error* olderr)
   
10.         (princ)
    
11. )
    
12. 
    
13. (defun C:texsrch (/ tset l n e os as ns st s nsl osl sl si chf chm olderr)
    
14. 
    
15.         (setq
    
16.                 olderr *error*
    
17.                 *error* myerr
    
18.                 chm 0
    
19.         )
    
20.         (menucmd "S=SELECT")
    
21.         (prompt "\n选取要编辑的文字 <所有>: ")
    
22.         (if (null (setq tset (ssget '((0 . "TEXT")))))
    
23.                 (setq tset (ssget "x" (list (cons 0 "TEXT"))))
    
24.         )
    
25.         (menucmd "S=")
    
26.         (cond
    
27.                 ((null tset) (prompt "\n图形中不存在TEXT文字."))
    
28.                 (t (terpri)
    
29.                         (princ (itoa (sslength tset)))
    
30.                         (prompt " 个TEXT文字选取.")
    
31.                         (command "undo" "mark")
    
32.                 )
    
33.         )
    
34.         (cond
    
35.                 ((null tset) (prompt "\nNothing Modified."))
    
36.                 (t
    
37.                         (while (= 0 (setq osl (strlen
    
38.                                 (setq os (getstring t "\n要替换的字符: ")))))
    
39.                                 (princ "无效的空输入")
    
40.                         )
    
41.                         (setq nsl (strlen (setq ns (getstring t "\n新字符: "))))
    
42.                         (setq l 0 n (sslength tset))
    
43.                         (while (< l n)       
    
44.                                 (if (= "TEXT" (cdr (assoc 0 (setq e (entget (ssname tset l))))))
    
45.                                         (progn
    
46.                                                 (setq
    
47.                                                         chf nil
    
48.                                                         si 1
    
49.                                                         s (cdr (setq as (assoc 1 e)))
    
50.                                                 )
    
51.                                                 (while (= osl (setq sl (strlen
    
52.                                                         (setq st (substr s si osl)))))
    
53.                                                                 (if (= st os)
    
54.                                                                 (progn
    
55.                                                                         (setq s (strcat (substr s 1 (1- si)) ns
    
56.                                                                                 (substr s (+ si osl)
    
57.                                                                         )))
    
58.                                                                         (setq chf t)
    
59.                                                                         (setq si (+ si nsl))
    
60.                                                                 )
    
61.                                                                 (setq si (1+ si))
    
62.                                                         )
    
63.                                                 )
    
64.                                                 (if chf
    
65.                                                         (progn       
    
66.                                                                 (setq e (subst (cons 1 s) as e))
    
67.                                                                 (entmod e)
    
68.                                                                 (setq chm (1+ chm))
    
69.                                                         )
    
70.                                                 )
    
71.                                         )
    
72.                                 )
    
73.                                 (setq l (1+ l))
    
74.                         )
    
75.                         (princ "改变了 ")       
    
76.                         (princ chm)
    
77.                         (prompt " 个 text 行.")
    
78.                 )
    
79.         )
    
80.         (setq *error* olderr)
    
81.         (princ)
    
82. )
    
83.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun myerr (s)<br />         (if (/= s "Function cancelled")<br />                 (princ (strcat "\nError: " s))<br />         )<br />         (setq tset nil)        <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 "\n选取要编辑的文字 <所有>: ")<br />         (if (null (setq tset (ssget '((0 . "TEXT")))))<br />                 (setq tset (ssget "x" (list (cons 0 "TEXT"))))<br />         )<br />         (menucmd "S=")<br />         (cond<br />                 ((null tset) (prompt "\n图形中不存在TEXT文字."))<br />                 (t (terpri)<br />                         (princ (itoa (sslength tset)))<br />                         (prompt " 个TEXT文字选取.")<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 "\n要替换的字符: ")))))<br />                                 (princ "无效的空输入")<br />                         )<br />                         (setq nsl (strlen (setq ns (getstring t "\n新字符: "))))<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 "改变了 ")        <br />                         (princ chm)<br />                         (prompt " 个 text 行.")<br />                 )<br />         )<br />         (setq *error* olderr)<br />         (princ)<br /> )<br />   [/FONT]<br />

aeo

应该没cad自带的"_find"好

hqd9639

R14中好像没有FIND（如没装bouns)

cuizt

hqd9639兄：你的lisp程序我试了一下，替换功能是有了，可查找的功能没有。如果能够加上自动查找功能就好了。也就是说，能够自动查找相同的字符串，修改其中的字符。对于lisp编程，我是外行，只会用，不会写，仅提建议。