分享一个剪贴板批量替换CAD文本函数，顺便求对CAD中K52+310之类字符串加减某一值代码

cchessbd

爱提问的我又来了，求对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
                        (setq  IEOBJ (vlax-create-object "htmlfile" ))
                        (setq  STR (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 (setq  N (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)

hm6313967

大师厉害了  不知道用在什么上面   目前用不到！感谢 有你更精彩！

mikewolf2k

巧了，前段时间我也升级的文本替换程序，支持正则表达式，捕获到的字符串支持数值运算，比如 E100， 后面的100运算+100更改为E200，如果是字符，就计算其ASCII码，比如5A运算+1获得5B。

中国梦

a谢谢分享，下载学习了