查找替换（三领的）
本帖最后由 尘缘一生 于 2022-11-28 23:45 编辑查找替换，是经典功能，本坛很多，我也有，不是没有，展示下：
提不出全部源码，见谅。。。。
支持几乎所有含有 文字的实体类型，包括标注，块类，多行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)
[*])
[*]
[*];;筛选选择集中文字，文字中字符 以旧换新-------【一级】---------
[*];; (reptextss <要找的文字> <替换成的文字>)
[*](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 (sl:List->String sText "\\P"))
[*](command "UCS" "P")
[*](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 (sl:List->String sText "\\P"))
[*](command "UCS" "P")
[*](Make-MText sText ptLeftTop fRecWidth fHeight fSpace ang 1 1)
[*](mapcar 'eval e_lst)
[*])
链接：https://pan.baidu.com/s/1RA53nRQM567jTvy12MZRtA
提取码：n3jd
本帖最后由 尘缘一生 于 2022-11-19 21:20 编辑
rocking2008 发表于 2022-11-19 15:58
替换后的文字的位置是不是发生了改变？
有微动错位，确实，我比较追求功能全面，智能，比功能不全面强，暂时这么用，
打开图纸，插件发现功能部分失效，是极其不能接收的心病。
本帖最后由 尘缘一生 于 2022-11-19 21:21 编辑
中国梦 发表于 2022-11-19 06:19
还可以，支持一下
已修改，主要想解决：多行MTEXT、块内实体问题， KO你 发表于 2024-2-22 17:18
能支持钢筋符号？
支持，集成里面处理了 还可以，支持一下 感谢大神分享，支持下～ 感谢大神分享{:1_1:} 感谢大神分享，支持下～ 谢谢 三领老师的代码 把属性块修改给解惑了 替换后的文字的位置是不是发生了改变？ 很不错的代码，学习一下
页:
[1]
2