[源码]批量文本替换

cabinsummer

编译后的文件，免费，供淘宝者使用
命令:RC

1. (defun c:rc(/ oldch newch sstxt ssl ct0 edata etext txtln subln ct1 ct2 schct DCL_ID newtext)
   
2.   (setvar "cmdecho" 0)
   
3.   (command "undo" "be")
   
4.   (setq oldch "" newch "")
   
5.   (if (> (setq DCL_ID (load_dialog "replace.dcl")) 0)
   
6.     (progn
   
7.       (if (new_dialog "replace" DCL_ID)
   
8.         (progn
   
9.           (mode_tile "oldword" 2)
   
10.           (action_tile "oldword" "(setq oldch $value)")
    
11.           (action_tile "newword" "(setq newch $value)")
    
12.           (start_dialog)
    
13.         )
    
14.         (princ "\n 不能显示对话框")
    
15.       )
    
16.       (unload_dialog DCL_ID)
    
17.     )
    
18.     (princ "\n 不能打开对话框")
    
19.   )
    
20.   (if (and (/= "" oldch)(/= oldch newch)(setq sstxt (ssget '((-4 . "<OR")(0 . "TEXT")(0 . "MTEXT")(-4 . "OR>")))))
    
21.     (progn
    
22.       (setq ssl (sslength sstxt)
    
23.             ct0 0
    
24.             ct1 0
    
25.             ct2 0
    
26.             subln (strlen oldch)
    
27.       )
    
28.       (while (< ct0 ssl)
    
29.         (setq edata (entget (ssname sstxt ct0))
    
30.               etext (cdr (assoc 1 edata))
    
31.               txtln (strlen etext)
    
32.               schct 1
    
33.               newtext ""
    
34.         )
    
35.         (while (<= schct txtln)
    
36.           (setq newtext
    
37.             (strcat newtext
    
38.               (if (= (setq readch (substr etext schct subln)) oldch)
    
39.                 (setq ct1 (1+ ct1)
    
40.                   schct (+ schct subln)
    
41.                   newch newch
    
42.                 )
    
43.                 (progn
    
44.                   (setq schct (1+ schct))
    
45.                   (substr readch 1 1)
    
46.                 )
    
47.               )
    
48.             )
    
49.           )
    
50.         )
    
51.         (if (/= etext newtext)
    
52.    (progn
    
53.             (entmod (subst (cons 1 newtext) (assoc 1 edata) edata))
    
54.             (setq ct2 (1+ ct2))
    
55.           )
    
56.         )
    
57.         (setq ct0 (1+ ct0))
    
58.       )
    
59.       (alert (strcat "所选文字中共有" (itoa ct2) "个文字含" (itoa ct1) "个 \"" oldch "\" 被替换为 \"" newch "\" ."))
    
60.     )
    
61.   )
    
62.   (command "undo" "e")
    
63.   (princ)
    
64. )

(defun c:rc(/ oldch newch sstxt ssl ct0 edata etext txtln subln ct1 ct2 schct DCL_ID newtext)<br />   (setvar "cmdecho" 0)<br />   (command "undo" "be")<br />   (setq oldch "" newch "")<br />   (if (> (setq DCL_ID (load_dialog "replace.dcl")) 0)<br />     (progn<br />       (if (new_dialog "replace" DCL_ID)<br />         (progn<br />           (mode_tile "oldword" 2)<br />           (action_tile "oldword" "(setq oldch $value)")<br />           (action_tile "newword" "(setq newch $value)")<br />           (start_dialog)<br />         )<br />         (princ "\n 不能显示对话框")<br />       )<br />       (unload_dialog DCL_ID)<br />     )<br />     (princ "\n 不能打开对话框")<br />   )<br />   (if (and (/= "" oldch)(/= oldch newch)(setq sstxt (ssget '((-4 . "<OR")(0 . "TEXT")(0 . "MTEXT")(-4 . "OR>")))))<br />     (progn<br />       (setq ssl (sslength sstxt)<br />             ct0 0<br />             ct1 0<br />             ct2 0<br />             subln (strlen oldch)<br />       )<br />       (while (< ct0 ssl)<br />         (setq edata (entget (ssname sstxt ct0))<br />               etext (cdr (assoc 1 edata))<br />               txtln (strlen etext)<br />               schct 1<br />               newtext ""<br />         )<br />         (while (<= schct txtln)<br />           (setq newtext<br />             (strcat newtext<br />               (if (= (setq readch (substr etext schct subln)) oldch)<br />                 (setq ct1 (1+ ct1)<br />                   schct (+ schct subln)<br />                   newch newch<br />                 )<br />                 (progn<br />                   (setq schct (1+ schct))<br />                   (substr readch 1 1)<br />                 )<br />               )<br />             )<br />           )<br />         )<br />         (if (/= etext newtext)<br />    (progn<br />             (entmod (subst (cons 1 newtext) (assoc 1 edata) edata))<br />             (setq ct2 (1+ ct2))<br />           )<br />         )<br />         (setq ct0 (1+ ct0))<br />       )<br />       (alert (strcat "所选文字中共有" (itoa ct2) "个文字含" (itoa ct1) "个 \"" oldch "\" 被替换为 \"" newch "\" ."))<br />     )<br />   )<br />   (command "undo" "e")<br />   (princ)<br /> )

1. replace:dialog
   
2. {
   
3.   label="替换文字串中指定子串";
   
4.   :edit_box
   
5.   {
   
6.     label="目标子串";
   
7.     key="oldword";
   
8.     allow_accept=true;
   
9.   }
   
10.   :edit_box
    
11.   {
    
12.     label="替换子串";
    
13.     key="newword";
    
14.     allow_accept=true;
    
15.   }
    
16.   ok_only;
    
17. }

replace:dialog<br /> {<br />   label="替换文字串中指定子串";<br />   :edit_box<br />   {<br />     label="目标子串";<br />     key="oldword";<br />     allow_accept=true;<br />   }<br />   :edit_box<br />   {<br />     label="替换子串";<br />     key="newword";<br />     allow_accept=true;<br />   }<br />   ok_only;<br /> }

chshsl

半夜星星 发表于 2019-4-29 11:06
最好是用EXCEL的方式来改,把需要改的列成二列,这种有没有弄过

有的，直接在CAD选两列文字，一对对替换。

ZJKUSO

能替换“#”，判断比较严格，要区分大小写
有个小遗憾，图块属性的文字无法替换
能不能加一个按钮，全图替换 和 框选替换 分开来

半夜星星

最好是用EXCEL的方式来改,把需要改的列成二列,这种有没有弄过

429014673

感觉还是CAD原带的好用。。。。

cabinsummer

429014673 发表于 2011-10-1 22:56
感觉还是CAD原带的好用。。。。

说对了！其实这是我十几年前在R14下开发的，那时AutoCAD还没有查找替换的功能。我是在明经上看到不少人还在发类似的东西，其实我们很多功能都是重复开发。放眼望去，明经上的程序很多只有简单的功能，还像个宝一样编译。所以我贴出十几年前的源码供大家学习。

hzj526

楼主的分享精神值得学习，支持

cabinsummer

hzj526 发表于 2011-10-4 23:07
楼主的分享精神值得学习，支持

感谢上帝、感谢AutoCAD、感谢明经，这么旧的程序现在还能用

yanshengjiang

感谢上帝。感谢风。

yanshengjiang

(ssget '((-4 . "<OR")(0 . "TEXT")(0 . "MTEXT")(-4 . "OR>")))))

好像能
(ssget '((0 . "*text")))

yoyoho

感谢cabinsummer楼主
分享学习!

jicqj

好帖啊

VBALISPER

感谢楼主的同时,也建议大家理解一下新手吧.一个新手,花了大量的时间学会了编制一个简单的功能.对他来说,不亚于一个科学家搞出个原子弹来.让他沉浸在胜利的喜悦之中一段时间吧.