[LISP程序]：查找替换文本中的字串（利用xdrx_api）－－喜欢R14的有用。

libo2000

;;;查找替换文本中的字串
(defun c:cheng_replace ( / loop n i tmp e0  etype etext new_etext old_etext ename ss update edate elist)
;;替换文字对象类型：单行、多行、标注、ATTDEF文字。
  (setq loop T)
  (setq n 0)
  (princ "\n 替换前的字符< ")  (princ cheng_oldtext)  (princ " > /选择文字目标(S) ：")
  (setq tmp (getstring))
  (if (and (/= tmp "") (/= tmp nil))
        (setq cheng_oldtext tmp)
  )
  (if (or (= tmp "S") (= tmp "s")) (setq cheng_oldtext (cdr (assoc 1 (entget (car (nentsel)))))))
  (princ "\n 替换后的字符< ") (princ cheng_newtext) (princ " > /选择文字目标(S) ：")
  (setq tmp (getstring))
  (if (and (/= tmp "") (/= tmp nil))     
        (setq cheng_newtext tmp)
  )
  (if (or (= tmp "S") (= tmp "s")) (setq cheng_newtext (cdr (assoc 1 (entget (car (nentsel)))))))
  (setq e0  (getstring "\n 选择欲替换的文本对象(S)/全部选择(A)：<All>" ))
  (if (or (= e0 "") (= e0 nil) (= e0 "A") (= e0 "a"))
    (progn            
      (setq ss (ssget "x" '((-4 . "<or") (0 . "TEXT") (0 . "DIMENSION") (0 . "MTEXT") (0 . "ATTDEF") (-4 . "or>"))))
      (setq i 0)
      (setq ename (ssname ss i) )
    )
    (progn
      (setq e0 (nentsel))
      (setq ename (car e0))
      (setq i -1)
    )
  )   
  (while ename   
    (if (> i 0)  (setq ename (ssname ss i )))   
    (if (/= i -1) (setq i (+ i 1)))
    (if ename
      (progn
        (setq elist (entget ename))
        (setq etype (cdr (assoc 0 elist)))
        (if (or (= etype "TEXT") (= etype "DIMENSION") (= etype "MTEXT") (= etype "ATTDEF"))
          (progn
            (setq edate (assoc 1 elist))
            (if (= etype "ATTDEF") (setq edate (assoc 2 elist)))
            (setq etext (cdr edate))            
            (setq new_etext (xdrx_string_replace etext cheng_oldtext cheng_newtext))
            (if (/= new_etext nil)
              (progn
                (setq update (cons 1 new_etext))
                (if (= etype "ATTDEF") (setq update (cons 2 new_etext)))
                (setq elist (subst update edate elist))
                (entmod elist)
                (if (and (< i 0) (setq e0 (car (reverse (cadddr e0))))) (entupd e0))
                (setq n (+ n 1))
                (if (= i -1)
                  (progn
                    (princ "\n 已替换了") (princ n) (princ "个。")
                  )
                )
              )
             (if (= i -1) (princ "\n 未找到匹配字符。"))
            )             
          )
        )
      )
    )   
    (if (= i -1)
      (progn        
        (setq e0 (nentsel "\n 选择欲替换的文本对象："))
        (if e0 (setq ename (car e0)) (setq ename nil))
      )
    )
  )
  (if (/= i -1)
    (progn
      (princ "\n 已替换了") (princ n) (princ "个。")
    )
  )
  (princ)
);;;end cheng_replace

;;;查找文本中的字串
(defun c:cheng_find ( / loop n i tmp e0  ss find_text ename elist edate etext)
;;查找文字对象类型：单行、多行、标注、ATTDEF文字。
  (setq loop T)
  (setq n 0)
  (princ "\n 欲查找的字符串/选择文字目标(S) ：")
  (setq tmp (getstring))
  (if (and (/= tmp "") (/= tmp nil))
        (setq find_text tmp)
  )
  (if (or (= tmp "S") (= tmp "s")) (setq find_text (cdr (assoc 1 (entget (car (entsel)))))))
  (setq e0  (getstring "\n 选择欲查找的文本对象(S)/全部选择(A)：<All>" ))
  (if (or (= e0 "") (= e0 nil) (= e0 "A") (= e0 "a"))  
      (setq ss (ssget "x" '((-4 . "<or") (0 . "TEXT") (0 . "DIMENSION") (0 . "MTEXT") (0 . "ATTDEF") (-4 . "or>"))))
      (setq ss (ssget '((-4 . "<or") (0 . "TEXT") (0 . "DIMENSION") (0 . "MTEXT")  (0 .  "ATTDEF") (-4 . "or>"))))
  )   
  (setq i 0)
  (setq ename (ssname ss i ) )
  (setq cheng_ss (ssadd))
  (while ename
    (if (> i 0)  (setq ename (ssname ss i )))   
    (setq i (+ i 1))
    (if ename
      (progn
        (setq elist (entget ename))
        (setq edate (assoc 1 elist))
        (if (= (cdr (assoc 0 elist)) "ATTDEF") (setq edate (assoc 2 elist)))
        (setq etext (cdr edate))
        (if (/= (xdrx_string_find etext find_text) nil)
          (progn
            (setq n (+ n 1))
            (ssadd ename cheng_ss)
          )
        )
      )
    )
  )
  (princ "\n 已找到了") (princ n) (princ "个。")
  (princ)
);;;end cheng_replace

lt_zzy

我将你的程序代码拷下来，形成了一个LSP文件，可是我加载以后，发现不能加载，提示是：
Error: invalid dotted pair*Cancel*
我感觉可以括号的问题，我花了半天也没有搞定，
麻烦你看看是不是你粘贴的时候少了什么东西。
谢谢！

XDSoft

[QUOTE]最初由 libo2000 发布
;;;查找替换文本中的字串
QUOTE]

XDRX_API 对于文字查找替换，提供了更集成的函数，见下面，用它可以再减少代码。

1. [font=courier]
   
2. 
   
3. 10.xdrx_txtsrch
   
4. 
   
5. 调用格式：(xdrx_txtsrch <父字符串> <子字符串> [大小写匹配标志])
   
6. 
   
7. 功能：在父字符串中查找子字符串，若存在，返回子字符串在父字符串中的位置，找到后，若没有到达
   
8.       父字符串尾，接着查找。
   
9. 
   
10. 返回值：若找到，返回位置表，否则，返回NIL。
    
11. 
    
12. 示例：
    
13.   (xdrx_txtsrch "abdscda" "bd") 返回(2)
    
14.   (txtsrch "abdscda" "d")  返回 (3 6)
    
15.   (txtsrch "abdscda" "BD") 返回 (2)
    
16.   (txtsrch "abdscda" "BD" T) 返回NIL,加T,表示区别大小写，不加，默认是NIL(不区分大小写)
    
17. 
    
18. [/font]

复制代码

XDSoft

最初由 lt_zzy 发布
[B]我将你的程序代码拷下来，形成了一个LSP文件，可是我加载以后，发现不能加载，提示是：
Error: invalid dotted pair*Cancel*
我感觉可以括号的问题，我花了半天也没有搞定，
麻烦你看看是不是你粘贴的时候少了什?.. [/B]

错误的提示是“点对”，你查看下代码，注意下 . 的前后要留一个空格，试试。

aeo

2002下不是自带的吗?

r14也有cht.lsp (support下)

lt_zzy

libo2000：
对不起，我将你的代码改了一下，现成可以加载了，好象执行不了。
(defun c:cheng_replace( / loop n i tmp e0 etype etext new_etext old_etext ename ss update edate elist)
  (setq loop T n 0)
  (princ "\n 替换前的字符< ") (princ cheng_oldtext) (princ " > /选择文字目标(S) ：")
  (setq tmp (getstring))
  (if (and (/= tmp "") (/= tmp nil))
    (setq cheng_oldtext tmp)
  )
  (if (or (= tmp "S") (= tmp "s")) (setq cheng_oldtext (cdr (assoc 1 (entget (car (entsel)))))))
  (princ "\n 替换后的字符< ") (princ cheng_newtext) (princ " > /选择文字目标(S) ：")
  (setq tmp (getstring))
  (if (and (/= tmp "") (/= tmp nil))
    (setq cheng_newtext tmp)
  )
  (if (or (= tmp "S") (= tmp "s")) (setq cheng_newtext (cdr (assoc 1 (entget (car (entsel)))))))
  (setq e0 (getstring "\n 选择欲替换的文本对象(S)/全部选择(A)：" ))
  (if (or (= e0 "") (= e0 nil) (= e0 "A") (= e0 "a"))
    (progn
      (setq ss (ssget "x" '((-4 .  (setq i 0)))))
      (setq ename (ssname ss i) )
    )
    (progn
      (setq e0 (nentsel))
      (setq ename (car e0))
      (setq i -1)
    )
  )
  (while ename
    (if (> i 0) (setq ename (ssname ss i )))
    (if (/= i -1) (setq i (+ i 1)))
    (if ename
      (progn
        (setq elist (entget ename))
        (setq etype (cdr (assoc 0 elist)))
        (if (or (= etype "TEXT") (= etype "DIMENSION") (= etype "MTEXT") (= etype "ATTDEF"))
          (progn
            (setq edate (assoc 1 elist))
            (if (= etype "ATTDEF") (setq edate (assoc 2 elist)))
            (setq etext (cdr edate))
            (setq new_etext (xdrx_string_replace etext cheng_oldtext cheng_newtext))
            (if (/= new_etext nil)
              (progn
                (setq update (cons 1 new_etext))
                (if (= etype "ATTDEF") (setq update (cons 2 new_etext)))
                (setq elist (subst update edate elist))
                (entmod elist)
                (if (and (< i 0) (setq e0 (car (reverse (cadddr e0))))) (entupd e0))
                (setq n (+ n 1))
                (if (= i -1)
                  (progn
                    (princ "\n 已替换了") (princ n) (princ "个。")
                  )
                )
              )
              (if (= i -1) (princ "\n 未找到匹配字符。"))
            )
          )
        )
      )
    )
    (if (= i -1)
      (progn
        (setq e0 (nentsel "\n 选择欲替换的文本对象："))
        (if e0 (setq ename (car e0)) (setq ename nil))
      )
    )
  )
  (if (/= i -1)
    (progn
      (princ "\n 已替换了") (princ n) (princ "个。")
    )
  )
  (princ)
)

libo2000

不能执行可能是copy‘s post把空格及其他一些东东搞掉了。
看附件cheng2.lsp把

to lt_zzy >>>>

(setq ss (ssget "x" '((-4 . (setq i 0)))))
＝＝>>>
显示错误！！
<<<===
把(entsel)改为(nentsel)
其他的我看了头疼！！！！！！^_^ -----不知道你改了那些地方？？
我把它搞成cheng2.lsp，你下载看看。
我测试了，应该可以(load)。
为了简单，我利用了xdrx_api所以可能有些没有安装晓东工具的不能(load)

libo2000

拷贝时候帖子被自动改动，少了些东东。看看附件