求cad文字内斜杠/前后的字符互换
所有选中的文字，斜杠前后的字符互换，且斜杠前的互换范围不超过空格，比如将6D25 4/2改为6D25 2/4结构底板梁配筋经常用到。 以前见过这样的程序，论坛上找了好久没找到，请大家帮忙。 (vl-load-com)
(defun c:test1 (/ ss n lst str)
(defun wkgcl (str / lst)
(while (vl-string-search "/" str)
(setq str (vl-string-subst "\"\"" "/" str))
)
(setq str (strcat "(\"" str "\")"))
(setq lst (read str)
lst (reverse lst)
)
(setq lst (mapcar '(lambda (x) (strcat x "/")) lst))
(setq str (vl-string-right-trim "/" (apply 'strcat lst)))
)
(defun ykgcl (str / len i str1 str2)
(setq len(strlen str)
i (vl-string-search " " str)
str1 (substr str 1 (1+ i))
str2 (substr str (+ i 2))
)
(setq str (strcat str1 (wkgcl str2)))
)
(setq ss (ssget '((0 . "text"))))
(repeat (setq N (sslength ss))
(setq LST (cons (ssname SS (setq N (1- N))) LST))
)
(mapcar
'(lambda (en)
(setq ent (entget en)
str (cdr (assoc 1 ent))
)
(if (and (vl-string-search "/" str) (vl-string-search " " str))
(entmod (subst (cons 1 (ykgcl str)) (assoc 1 ent) ent))
(if (vl-string-search "/" str)
(entmod (subst (cons 1 (wkgcl str)) (assoc 1 ent) ent))
)
)
)
lst
)
(princ)
)试试这个 本帖最后由 夏生生 于 2014-9-5 10:32 编辑
(defun c:test1 (/ en ent str n len i str1 str2)
(while (and (setq en (car (entsel)))
(= "TEXT" (cdr (assoc 0 (setq ent (entget en)))))
(setq n (vl-string-search "/" (setq str (cdr (assoc 1 ent)))))
)
(setq len(strlen str)
i (vl-string-search " " str)
str1 (substr str (+ n 2))
str2 (substr str (+ i 2) (- n i 1))
str (strcat (substr str 1 i) " " str1 "/" str2)
)
(entmod (subst(cons 1 str)(assoc 1 ent) ent))
)
)对于两排以上,由于一般来讲仅第一或最后一排不同，故本程序亦可处理，对于第一排移至最后一排点一次，对于最后一排移至第一排点排数次
运行了一下程序，这里还有几个问题。
1.程序中斜杠前后没数字就不起效果，能不能调整为不管斜杠前后是什么都互换，
即不仅能将6D25 4/2改为6D25 2/4,也能将6D25/2D22变为2D22/6D25
2.能不能满足一次选择无论几排钢筋都能互换，比如6D25/6D22/2D22改为2D22/6D22/6D25
3.程序只能选择一个改一个，能不能框选后全部修改？ 1981yyzz 发表于 2014-9-5 20:54 static/image/common/back.gif
运行了一下程序，这里还有几个问题。
1.程序中斜杠前后没数字就不起效果，能不能调整为不管斜杠前后是什么 ...
如果有3个/怎么调换...?? 前面写那个原理都有了，步骤也比较清晰，自己稍微修改一下就行 (defun AYL-DivideString(Str Sep / Sub Lst)
(setq Sub "")
(while (= (substr Str 1 1) Sep)
(setq Sub (strcat Sub Sep))
(setq Str (substr Str 2))
)
(if (= Sub "")
(setq Lst nil)
(setq Lst (list Sub))
)
(while (setq val (vl-string-search Sep Str))
(setq Lst (cons (substr Str 1 Val) Lst))
(setq Str (substr Str (1+ Val)))
(setq Sub "")
(while (= (substr Str 1 1) Sep)
(setq Sub (strcat Sub Sep))
(setq Str (substr Str 2))
)
(setq Lst (cons Sub Lst))
)
(or (= Str "") (setq Lst (cons Str Lst)))
Lst
)
(defun AYL-ssClist (ss / EnLst n)
(setq EnLst nil)
(repeat (setq n (sslength ss))
(setq EnLst (cons (ssname ss (setq n (1- n))) EnLst))
)
)
(defun AYL-FixedString (Str / Lst1 Lst2)
(setq Lst0 (AYL-DivideString Str " ") Lst1 nil)
(while (setq Item (car Lst0))
(setq Lst0 (cdr Lst0))
(setq Lst2 (AYL-DivideString Item "/"))
(setq Lst1 (append Lst2 Lst1))
)
(apply 'strcat Lst1)
)
;|
(defun c:test (/ en ent str)
(while (setq en (car (entsel)))
(and (= "TEXT" (cdr (assoc 0 (setq ent (entget en)))))
(setq str (AYL-FixedString (cdr (assoc 1 ent))))
(entmod (subst (cons 1 str) (assoc 1 ent) ent))
)
)
(princ)
)
|;
(defun c:tt (/ EntLst)
(if (setq ss (ssget '((0 . "*Text"))))
(progn
(setq EntLst (AYL-ssClist ss)
ss nil
)
(mapcar
(function
(lambda (x / a b)
(setq a (entget x)
b (assoc 1 a)
)
(entmod (subst (cons 1 (AYL-FixedString (cdr b))) b a))
)
)
EntLst
)
)
)
(princ)
) 感谢夏生生和nzl1116两位前辈的解答。 留个脚印，记录下。后续可能用得到 感谢nzl1116大师的源码，为您点赞！
页:
[1]