分享一个剪贴板批量替换CAD文本函数，顺便求对CAD中K52+310之类字符串加减某一值代码
本帖最后由 cchessbd 于 2023-3-2 17:37 编辑爱提问的我又来了，求对CAD中AK2+310之类字符串加减某一值的代码。输出文本亦为原格式。
比如： K60+520 加800后，输出 K61+320
BK0+132 减600后，输出-BK0+468
DK0+300 加700后，输出 DK1+000。
2023.02.21，在此记录一下，这个代码我也快写出来了。
2023.03.01。调试了几天，终于可以了。达到了我要的完美的效果！
下面再分享一段代码：虽然最近事情虽然很多，但抽时间来研读论坛大神写的代码。学了不少东西
自己也写了个复制WPS EXCEL数据，再批量替换CAD文本的函数。部分代码来自论坛，谢谢！
支持文本匹配过滤，如 (TxtFromClip “K”) 为选择“*K*”的文本进行替换。
支持文本匹配过滤，如 (TxtFromClip “+”) 为选择“*+*”的文本进行替换。
;;--------------------
;;说明:将剪贴板中的文本转换为list
;;返回:转换之后的list，如果从excel中复制，得到的list为二维。
(DEFUN LN-GET-CLIPTEXT( / IEOBJ STR )
(AND
(setqIEOBJ (vlax-create-object "htmlfile" ))
(setqSTR (vlax-invoke (vlax-get (vlax-get IEOBJ 'PARENTWINDOW ) 'CLIPBOARDDATA ) 'GETDATA "Text" ))
(vlax-release-object IEOBJ )
)
STR
)
(DEFUN LN-STR2LSTSPR( STR SUB/ LST N )
(while (and (setqN (VL-STRING-SEARCH SUB STR )))
(setq LST (CONS (SUBSTR STR 1 N ) LST ))
(setq STR (SUBSTR STR (+ N (STRLEN SUB ) 1 ) ))
)
(VL-REMOVE "" (REVERSE (CONS STR LST ) ) )
)
(DEFUN str_Clipboard2List (/ A ans B C D LST parse_tmp)
(setq A (LN-GET-CLIPTEXT ))
;(alert "")
(setq B (LN-STR2LSTSPR A "\r\n" )) ;根据换行符对剪贴板文本进行分行。
(setq Ans nil)
(foreach X B ;根据分列符，将每行中的内容进行分列。
(setq parse_tmp (LN-STR2LSTSPR X "\t" ))
(setq Ans (cons parse_tmp Ans))
)
(setq Ans(reverse Ans))
)
;;--------------------
;;--------------------
;;取出字符串里面的数字，返回数字表，分隔符需指定
(defun Parse_zhs (str del / pos lst)
(while (setq pos (vl-string-search del str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ pos 1 (strlen del)))
)
)
(reverse (cons str lst))
)
;;--------------------
;;--------------------
;;取出字符串里面的数字，返回数字表，无论分隔符是啥
(defun split-numbers (str / buff l2)
(setq str (vl-string->list str))
(while str
(if(< 47 (car str) 58)
(setq buff (cons (car str) buff))
(if buff
(setq l2 (cons (vl-list->string (reverse buff)) l2)
buff nil
)
)
)
(setq str (cdr str))
)
(if buff
(setq l2 (cons (vl-list->string (reverse buff)) l2))
)
(reverse l2)
)
;;--------------------
;;--------------------
;;批量文本替换 by AA2015.10.31，以第一次选择文本内容，依次替换第二次选择的文本
;;(defun c:TXTR (/ I II LST1 LST2 SS1 EN0 ENT TEXT1 SSN1 SS2 EN1 ENT1 TEXT2 TEXT3 NTXT ENTS)
(defun c:TXTR ()
(setvar "CMDECHO" 0)
(setq i 0 ii 0 lst1 '() lst2 '())
(setq ss1 (ssget '((0 . "TEXT")))) ;第一次选择的表
(repeat (sslength ss1)
(setq en0 (ssname ss1 i))
(setq ent (entget en0))
(setq text1 (cdr(assoc 1 ent))) ;获得文字内容
(setq lst1 (cons text1 lst1))
(setq i (1+ i))
)
(setq ssn1 (reverse lst1))
(setq ss2 (ssget '((0 . "TEXT")))) ;第二次选择的表
(repeat (sslength ss2)
(setq en1 (ssname ss2 ii))
(setq ent1 (entget en1))
(setq text2 (assoc 1 ent1)) ;获得文字内容
(setq text3 (nth ii ssn1))
(setq ntxt (cons 1 text3))
(setq ents (subst ntxt text2 ent1))
(entmod ents)
(setq ii (1+ ii))
)
(princ)
)
;;--------------------
;;剪贴板内容批量替换，文本Kxxx+xxx之类
;;
(defun TxtFromClip (str1gl / i ii ssn1 ent1 ss1 ss2 )
(setvar "CMDECHO" 0)
(setq ii 0)
(setq ss2 (str_Clipboard2List));;获取剪贴板内容并按行列排序
(if (/= nil ss2)
(progn
;选择文字，默认框选所有文本，支持参数str1匹配
(if (= nil str1gl)
(setq ss1 (ssget (list (cons 0 "TEXT") )))
(setq ss1 (ssget (list (cons 0 "TEXT") (cons 1 (strcat "*" str1gl "*")))))
);end if
(setq i (min (sslength ss1) (length ss2)))
(repeat i
(setq text2 (nth ii ss2));获得文字内容
(setq ssn1 (ssname ss1 (- i 1 ii)));;待替换文字图元名
(setq ent1 (entget ssn1));;图元定义
(if (= text2 (rtos (atoi (car text2))))
(entmod (subst (cons 1 (rtos (atoi (car text2)) 2 0)) (assoc 1 ent1) ent1));;替换WPS纯数字(cons 1 "123.0")= (1 "123")
(entmod (subst (cons 1 (car text2)) (assoc 1 ent1) ent1));;替换非数字文本
)
(entupd ssn1);;更新
(setq ii (1+ ii))
)
)
);end if
(setq str1gl nil)
(princ)
)
(defun c:T4C ()(TxtFromClip nil))
(defun c:T4Cc (str1)(TxtFromClip str1))
;;--------------------
;;--------------------
;;--------------------
(princ)
大师厉害了不知道用在什么上面 目前用不到！感谢 有你更精彩！ 巧了，前段时间我也升级的文本替换程序，支持正则表达式，捕获到的字符串支持数值运算，比如 E100， 后面的100运算+100更改为E200，如果是字符，就计算其ASCII码，比如5A运算+1获得5B。 a谢谢分享，下载学习了
页:
[1]