查找替换（三领的）

尘缘一生

查找替换，是经典功能，本坛很多，我也有，不是没有，展示下：
提不出全部源码，见谅。。。。
支持几乎所有含有 文字的实体类型，包括标注，块类，多行MTEXT等

注：还是走了弯路，因为我解决不了一大片MTEXT文字，取字符串和定位的问题，也是刚发帖求助了
http://bbs.mjtd.com/thread-186647-1-1.html?_dsign=34261847
如果能解决上述问题，代码将大大的不一样，速度也会快的很多，并且还不出BUG。

• ;;替换改字并换色---------------
• (defun c:chgtext (/ std ss os ns oldcho dcl_id name)
•   (setq oldcho (getvar "cmdecho"))
•   (setvar "cmdecho" 0)
•   (setq std 1 os "" ns "")
•   (while (> std 0)
•     (setq dcl_id (load_dialog (th-dcl)))
•     (new_dialog "replace" dcl_id)
•     (set_tile "oldword" os)
•     (set_tile "newword" ns)
•     (action_tile "oldword" "(setq os (get_tile \"oldword\"))")
•     (action_tile "newword" "(setq ns (get_tile \"newword\"))")
•     (action_tile "pick_1" "(done_dialog 1)")
•     (action_tile "pick_11" "(done_dialog 2)")
•     (action_tile "accept" "(done_dialog 0)")
•     (setq std (start_dialog))
•     (slunloaddcl dcl_id)
•     (cond
•       ((= std 1)
•         (setq name (car (entsel (slmsg "\n 点选旧字符串:" "\n 點選舊字符串:" "\n Click the old string:"))))
•         (setq os (getstr name))
•       )
•       ((= std 2)
•         (setq name (car (entsel (slmsg "\n 点选新字符串:" "\n 點選新字符串:" "\n Click the new string:"))))
•         (setq ns (getstr name))
•       )
•     )
•   )
•   (princ (slmsg "\n 选择含有文字类实体:" "\n 選擇含有文字類實體:" "\n Select entities containing text:"))
•   (while (setq ss (ssget ":S" '((0 . "ATTDEF,DIMENSION,TEXT,MTEXT,INSERT,TCH_ARROW,TCH_TEXT,TCH_DRAWINGNAME,TCH_MULTILEADER,TCH_ELEVATION,TCH_MTEXT,ATTRIB"))))
•     (if (and ss (/= os "") (/= ns ""))
•       (reptext ss os ns)
•     )
•     (princ (slmsg "\n 选择含有文字类实体:" "\n 選擇含有文字類實體:" "\n Select entities containing text:"))
•   )
•   (setvar "cmdecho" oldcho)
• )
• ;;---------------------
• (defun th-dcl (/ lst_str)
•   (setq lst_str
•     (cond
•       ((= $Lgver 1)
•         (list
•           "replace:dialog {"
•           "label = \"       替换含文字实体中指定子串\";"
•           "initial_focus=oldword;"  
•           ":boxed_row{"
•           "label=\"旧字符串:\";"
•           ":edit_box {key = \"oldword\";edit_width = 25;allow_accept=true;}"
•           ":button{label=\"<--点取+\";key=\"pick_1\";}"
•           "}"
•           ":boxed_row{"
•           "label=\"新字符串:\";"
•           ":edit_box {key = \"newword\";edit_width = 25;allow_accept=true;}"
•           ":button{label=\"<--点取+\";key=\"pick_11\";}"
•           "}"
•           $okbt
•           "}"
•         )
•       )
•       ((= $Lgver 2)
•         (list
•           "replace:dialog {"
•           "label = \"       替換含文字實體中指定子串\";"
•           "initial_focus=oldword;"  
•           ":boxed_row{"
•           "label=\"舊字符串:\";"
•           ":edit_box {key = \"oldword\";edit_width = 25;allow_accept=true;}"
•           ":button{label=\"<--點取+\";key=\"pick_1\";}"
•           "}"
•           ":boxed_row{"
•           "label=\"新字符串:\";"
•           ":edit_box {key = \"newword\";edit_width = 25;allow_accept=true;}"
•           ":button{label=\"<--點取+\";key=\"pick_11\";}"
•           "}"
•           $okbt
•           "}"
•         )
•       )
•       ((= $Lgver 3)
•         (list
•           "replace:dialog {"
•           "label = \"Replace the middle stator string of entities with text\";"
•           "initial_focus=oldword;"  
•           ":boxed_row{"
•           "label=\"Old String:\";"
•           ":edit_box {key = \"oldword\";edit_width = 25;allow_accept=true;}"
•           ":button{label=\"<--Pick+\";key=\"pick_1\";}"
•           "}"
•           ":boxed_row{"
•           "label=\"New String:\";"
•           ":edit_box {key = \"newword\";edit_width = 25;allow_accept=true;}"
•           ":button{label=\"<--Pick+\";key=\"pick_11\";}"
•           "}"
•           $okbt
•           "}"
•         )
•       )
•     )
•   )
•   (dcl2lisp lst_str)
• )  
• 
  
  • ;;筛选选择集中文字，文字中字符 以旧换新-------【一级】---------
  • ;; (reptext  ss <要找的文字> <替换成的文字>)
  • (defun reptext (ss oldch newch / enam p n tp etext txtln subln n1 schct newtext readch)
  •   (repeat (setq n (sslength ss))
  •     (setq enam (ssname ss (setq n (1- n))) tp (dxf1 enam 0))
  •     (cond
  •       ((or (= tp "MTEXT") (= tp "TCH_MTEXT"))
  •         (sl-mtext-old-new enam oldch newch)
  •         (ssdel enam ss)
  •       )
  •       ((= tp "INSERT")
  •         (blk-reptext enam oldch newch)
  •         (ssdel enam ss)
  •       )
  •     )
  •   )
  •   (if (setq p (sslength ss) subln (strlen oldch))
  •     (progn
  •       (setq n 0 n1 0)
  •       (while (< n p)
  •         (if (setq etext (getstr (setq enam (ssname ss n))))
  •           (progn
  •             (setq txtln (strlen etext) schct 1 newtext "")
  •             (while (<= schct txtln)
  •               (setq newtext
  •                 (strcat newtext
  •                   (if (= (setq readch (substr etext schct subln)) oldch)
  •                     (setq n1 (1+ n1) schct (+ schct subln) newch newch)
  •                     (progn
  •                       (setq schct (1+ schct))
  •                       (substr readch 1 1)
  •                     )
  •                   )
  •                 )
  •               )
  •             )
  •             (if (/= etext newtext)
  •               (chzi-enam enam newtext)
  •             )
  •           )
  •         )
  •         (setq n (1+ n))
  •       )
  •     )
  •   )
  • )
    

• ;;取实体字符串-----(一级)------
• (defun getstr (enam / e pt str en tp tp1 en2 obj lis)
•   (setq e (entget enam) tp (dxf1 e 0) obj (en2obj enam))
•   (cond
•     ((member tp '("TEXT" "TCH_TEXT"))
•       (setq str (dxf1 e 1))
•     )
•     ((member tp '("MTEXT" "TCH_MTEXT"))
•       (setq lis (str->lst (dxf1 e 1) ";"))
•       (if (> (length lis) 1)
•         (setq str (cadr lis))
•         (setq str (car lis))
•       )
•     )
•     ((= tp "DIMENSION")
•       (setq str (vla-get-textoverride obj))
•       (if (or (= str "") (wcmatch str "*<>*"))
•         (setq str (rtos (vla-get-measurement obj) 2 (vla-get-toleranceprecision obj)))
•       )
•     )
•     ((= tp "MULTILEADER")
•       (setq str (dxf1 e 304))
•     )
•     ((= tp "TCH_ARROW") ;天正箭头引注
•       (setq str (vlax-get-property obj 'Text2))
•     )
•     ((member tp '("ATTDEF" "TCH_MULTILEADER")) ;如果是属性字，则取“标记”为源文字 ;天正引出标注
•       (setq str (dxf1 e 2))
•     )
•     ((and (= tp "INSERT") (= (dxf1 e 66) 1)) ;;属性块 文字
•       (setq en (entget (entnext enam)))
•       (setq str (dxf1 en 1))
•     )
•     ((and (= tp "INSERT") (= (dxf1 e 66) 0)) ; 块内文字
•       (if (null pt) (setq pt (cadr (grread 5))))
•       (if (not (setq en2 (car (nentselp pt))))
•         (setq en2 enam)
•       )
•       (setq tp1 (dxf1 en2 0))
•       (if (member tp1 (list "TEXT" "MTEXT" "ATTRIB"))
•         (setq str (vla-get-textstring (en2obj en2)))
•       )
•     )
•   )
•   str
• )
  

• ;MTEXT中字符以旧换新-----(一级)------
• (defun sl-mtext-old-new (enam oldch newch / e)
•   (setq e (entlast))
•   (command "EXPLODE" enam)
•   (reptext (last_ent e) oldch newch)
•   (setq enam (sl-ss-txt2mtext (last_ent e)))
•   enam
• )
  
  • ;;块内实体文字，以旧换新---(一级)----
  • ;(blk-reptext <块实体名> <要找的文字> <替换成的文字>) (setq enam (car(entsel)))
  • ;;返回替换后的复原块 (blk-reptext (car(entsel)) "0" "1")
  • (defun blk-reptext (enam oldch newch / nam e ss)
  •   (setq nam (dxf1 enam 2))
  •   (while (tblsearch "block" nam)
  •     (setq nam (strcat nam (slsjqs)))
  •   )
  •   (setq e (entlast))
  •   (vl-catch-all-apply 'exp-blk (list enam))
  •   (if (setq ss (last_ent e))
  •     (progn
  •       (reptext ss oldch newch) ;;(reptext ss "0" "1")
  •       (setq ss (last_ent e))
  •       (emkblk ss (ssmpt ss) nam) ;;作普通块  
  •       (entlast)
  •     )
  •   )
  • )
    

• 
  
  • ;文字合并到 MTEXT-----(一级)-------
  • ;返回合并后的MTEXT
  • (defun sl-ss-txt2mtext (ss / e_lst n el box boxl l blst strl h h0 hn py st)
  •   (setq e_lst (sysvar '("textsize" "textstyle")) h0 0.5)
  •   (repeat (setq n (sslength ss))
  •     (setq  
  •       el   (entget (ssname ss (setq n (1- n))))
  •       box  (textbox (vl-remove (assoc 50 el) el))
  •       boxl (cons box boxl)
  •       l    (+ (abs (caadr box)) (abs (cadadr box)))
  •       blst (cons l blst)
  •       strl (cons (list (dxf1 el 10) (dxf1 el 1)) strl)
  •       hn   (dxf1 el 40)
  •       st   (if (not st) (dxf1 el 7) st)
  •     )
  •     (if (> hn h0) (setq h hn) (setq h h0))
  •     (setq h0 h)
  •   )
  •   (sl:-erase ss)
  •   (setvar "textsize" h)
  •   (if (/= (getvar "textstyle") st) (setvar "textstyle" st))
  •   (setq strl
  •     (vl-sort strl
  •       '(lambda (e1 e2)
  •          (if (equal (cadar e1) (cadar e2) 0.00001)
  •            (< (caar e1) (caar e2))
  •            (> (cadar e1) (cadar e2))
  •          )
  •        )
  •     )
  •     py (apply 'max (mapcar 'cadr (apply 'append boxl)))
  •   )
  •   (vla-addmtext *Model-Space*
  •     (vlax-3d-point (list (caaar strl) (+ py (cadaar strl))))
  •     (apply 'max blst)
  •     (apply 'strcat (mapcar '(lambda (x) (strcat (last x) "\\P")) strl))
  •   )
  •   (mapcar 'eval e_lst)
  •   (entlast) ;返回合并后MTEXT实体
  • )
    

以下为 信的文字选择集转MTEXT，这个比较好，存在的大缺憾就是垂直方向需要改写。

• ;单行文字选择集转多行文字----(一级)------
• ;ssText  文字选择集 fSpace 行距比例
• (defun sl-ss-txt2mtext (ssText fSpace / e_lst ptLeftTop fRecWidth Mats y lstText eText edata fHeight fWidth ang
•                          lst1 lstText1 e e1 e2 box lstReplace ename)
•   (setq e_lst (sysvar '("TEXTSTYLE" "CLAYER")))
•   (setq lstText (ss-enlst ssText))
•   (setq ename (ssname ssText 0))
•   (setq edata (entget ename))
•   (command "UCS" "OB" ename)
•   (setq lstText
•     (mapcar
•       '(lambda (eText / edata pt)
•          (setq edata (entget eText))
•          (setq pt (dxf1 edata 10))
•          (trans pt 0 1)
•          (list pt edata)
•        )
•       lstText
•     )
•   )
•   (setq lstText (vl-sort lstText '(lambda (e1 e2) (> (cadar e1) (cadar e2)))))
•   (setq y (cadaar lstText))
•   (foreach eText lstText
•     (setq fHeight (dxf1 (cadr eText) 40))
•     (if (< (abs (- y (cadar eText))) fHeight)    ;同行
•       (progn
•         (setq lst1 (cons eText lst1))
•         (setq y (cadar eText))
•       )
•       (progn
•         (setq lstText1 (cons lst1 lstText1))    ;加入
•         (setq y (cadar eText))
•         (setq lst1 (list eText))
•       )
•     )
•   )
•   (if lst1 (setq lstText1 (cons lst1 lstText1)))
•   (setq lstText
•     (mapcar
•       '(lambda (lst1)
•          (mapcar 'cadr (vl-sort lst1 '(lambda (e1 e2) (< (caar e1) (caar e2)))))
•        )
•       lstText1
•     )
•   )
•   (setq lstText (reverse lstText))
•   (setq fRecWidth
•     (apply
•       'max
•       (mapcar
•         '(lambda (e)
•            (if (> (length e) 1)
•              (apply
•                '+
•                (mapcar
•                  '(lambda (e1 / box)
•                     (setq box (textbox e1))
•                     (caadr box)
•                   )
•                  e
•                )
•              )
•              (caadr (textbox (car e)))
•            )
•          )
•         lstText
•       )
•     )
•   )
•   (setq fRecWidth (* fRecWidth 1.2) lst1 (caar lstText))
•   (setq fHeight (dxf1 lst1 40))
•   (setq ptLeftTop (dxf1 lst1 10))
•   (setq ang (dxf1 lst1 50))
•   (setq box (textbox lst1))
•   (setq ptLeftTop
•     (polar ptLeftTop ang
•       (apply 'min
•         (setq a
•           (vl-remove nil
•             (mapcar
•               '(lambda (lst / str)
•                  (setq str (dxf1 lst 1))
•                  (cond
•                    ((wcmatch str " *,　*") 0)
•                    ((> (ascii (substr str 1 1)) 128)
•                      0
•                    )
•                    (T
•                      (caar (textbox lst))
•                    )
•                  )
•                )
•               (mapcar 'car lstText)
•             )
•           )
•         )
•       )
•     )
•   )
•   (setq ptLeftTop (polar ptLeftTop (+ ang pi2) (apply 'max (mapcar '(lambda (e) (dxf1 e 40)) (car lstText)))))
•   (sl:-erase ssText)
•   (setvar 'clayer (dxf1 lst1 8))
•   (setvar 'TEXTSTYLE (dxf1 lst1 7))
•   (setq fWidth (dxf1 (tblsearch "Style" (getvar 'textstyle)) 41))
•   (setq sText
•     (mapcar
•       '(lambda (e)
•          (apply
•            'strcat
•            (mapcar
•              '(lambda
•                 (e1 / str h w c pre)
•                 (setq str (dxf1 e1 1))
•                 (setq h (dxf1 e1 40))
•                 (setq w (dxf1 e1 41))
•                 (setq c (dxf1 e1 62))
•                 (setq str (t-string-subst  "\\{" "{" str))
•                 (setq str (t-string-subst  "\\}" "}" str))
•                 (setq pre "")
•                 (if (not (equal h fHeight)) (setq pre (strcat pre "\\H" (rtos (/ h fHeight) 2 1) "x;")))
•                 (if (not (equal w fWidth)) (setq pre (strcat pre "\\W" (rtos w 2 1) ";")))
•                 (if c (setq pre (strcat pre "\\C" (rtos c 2 0) ";")))
•                 (if (/= pre "")
•                   (setq str (strcat "{" pre str "}"))
•                   str
•                 )
•               )
•              e
•            )
•          )
•        )
•       lstText
•     )
•   )
•   (setq sText (slist->String sText "\\P"))
•   (command "UCS" "")
•   (Make-MText sText ptLeftTop fRecWidth fHeight fSpace ang 1 1)
•   (mapcar 'eval e_lst)
• )
  

以下为我改写信的代码，目的减小码子，但调试发现BUG，目前没有找到问题之所在

• ;文字选择集转多行文字----(一级)------
• ;ssText 文字选择集 fSpace 行距比例
• (defun sl-ss-txt2mtext (ssText fSpace / e_lst y ptLeftTop fRecWidth lstText sText eText edata fHeight fWidth ang lst1 lstText1 e e1 e2 plis ename)
•   (setq e_lst (sysvar '("TEXTSTYLE" "CLAYER")))
•   (setq plis (ss9pt ssText nil))
•   (setq ptLeftTop (nth 6 plis) fRecWidth (distance (car plis) (caddr plis)))
•   (setq lstText (ss-enlst ssText))
•   (setq ename (ssname ssText 0))
•   (setq edata (entget ename))
•   (command "UCS" "OB" ename)
•   (setq lstText
•     (mapcar
•       '(lambda (eText / edata pt)
•          (setq edata (entget eText))
•          (setq pt (trans (dxf1 edata 10) 0 1))
•          (list pt edata)
•        )
•       lstText
•     )
•   )
•   (setq lstText (vl-sort lstText '(lambda (e1 e2) (> (cadar e1) (cadar e2)))))
•   (setq y (cadaar lstText))
•   (foreach eText lstText
•     (setq fHeight (dxf1 (cadr eText) 40))
•     (if (< (abs (- y (cadar eText))) fHeight)    ;同行
•       (progn
•         (setq lst1 (cons eText lst1))
•         (setq y (cadar eText))
•       )
•       (progn
•         (setq lstText1 (cons lst1 lstText1))    ;加入
•         (setq y (cadar eText))
•         (setq lst1 (list eText))
•       )
•     )
•   )
•   (if lst1 (setq lstText1 (cons lst1 lstText1)))
•   (setq lstText
•     (mapcar
•       '(lambda (lst1)
•          (mapcar 'cadr (vl-sort lst1 '(lambda (e1 e2) (< (caar e1) (caar e2)))))
•        )
•       lstText1
•     )
•   )
•   (setq lstText (reverse lstText))
•   (setq lst1 (caar lstText))
•   (setq fHeight (dxf1 lst1 40))
•   (setq ang (dxf1 lst1 50))
•   (sl:-erase ssText)
•   (setvar 'clayer (dxf1 lst1 8))
•   (setvar 'TEXTSTYLE (dxf1 lst1 7))
•   (setq fWidth (dxf1 (tblsearch "Style" (getvar 'textstyle)) 41))
•   (setq sText
•     (mapcar
•       '(lambda (e)
•          (apply
•            'strcat
•            (mapcar
•              '(lambda
•                 (e1 / str h w c pre)
•                 (setq str (dxf1 e1 1))
•                 (setq h (dxf1 e1 40))
•                 (setq w (dxf1 e1 41))
•                 (setq c (dxf1 e1 62))
•                 (setq str (t-string-subst  "\\{" "{" str))
•                 (setq str (t-string-subst  "\\}" "}" str))
•                 (setq pre "")
•                 (if (not (equal h fHeight)) (setq pre (strcat pre "\\H" (rtos (/ h fHeight) 2 1) "x;")))
•                 (if (not (equal w fWidth)) (setq pre (strcat pre "\\W" (rtos w 2 1) ";")))
•                 (if c (setq pre (strcat pre "\\C" (rtos c 2 0) ";")))
•                 (if (/= pre "")
•                   (setq str (strcat "{" pre str "}"))
•                   str
•                 )
•               )
•              e
•            )
•          )
•        )
•       lstText
•     )
•   )
•   (setq sText (slist->String sText "\\P"))
•   (command "UCS" "")
•   (Make-MText sText ptLeftTop fRecWidth fHeight fSpace ang 1 1)
•   (mapcar 'eval e_lst)
• )
  

链接：https://pan.baidu.com/s/1RA53nRQM567jTvy12MZRtA
提取码：n3jd

尘缘一生

rocking2008 发表于 2022-11-19 15:58
替换后的文字的位置是不是发生了改变？

有微动错位，确实，我比较追求功能全面，智能，比功能不全面强，暂时这么用，
打开图纸，插件发现功能部分失效，是极其不能接收的心病。

尘缘一生

中国梦 发表于 2022-11-19 06:19
还可以，支持一下

已修改，主要想解决：多行MTEXT、块内实体问题，

尘缘一生

KO你 发表于 2024-2-22 17:18
能支持钢筋符号？

支持，集成里面处理了

中国梦

还可以，支持一下

czb203

感谢大神分享，支持下～

hzyhzjjzh

感谢大神分享

paulpipi

感谢大神分享，支持下～   

zhangcan0515

谢谢 三领老师的代码 把属性块修改给解惑了

rocking2008

替换后的文字的位置是不是发生了改变？

baitang36

很不错的代码，学习一下