求cad文字内斜杠/前后的字符互换

1981yyzz

所有选中的文字，斜杠前后的字符互换，且斜杠前的互换范围不超过空格，比如将6D25 4/2改为6D25 2/4
结构底板梁配筋经常用到。 以前见过这样的程序，论坛上找了好久没找到，请大家帮忙。

夏生生

2. (vl-load-com)
   
3. (defun c:test1 (/ ss n lst str)
   
4.   (defun wkgcl (str / lst)
   
5.     (while (vl-string-search "/" str)
   
6.       (setq str (vl-string-subst """" "/" str))
   
7.     )
   
8.     (setq str (strcat "("" str "")"))
   
9.     (setq lst (read str)
   
10.           lst (reverse lst)
    
11.     )
    
12.     (setq lst (mapcar '(lambda (x) (strcat x "/")) lst))
    
13.     (setq str (vl-string-right-trim "/" (apply 'strcat lst)))
    
14.   )
    
15.   (defun ykgcl (str / len i str1 str2)
    
16.     (setq len  (strlen str)
    
17.           i    (vl-string-search " " str)
    
18.           str1 (substr str 1 (1+ i))
    
19.           str2 (substr str (+ i 2))
    
20.     )
    
21.     (setq str (strcat str1 (wkgcl str2)))
    
22.   )
    
23.   (setq ss (ssget '((0 . "text"))))
    
24.   (repeat (setq N (sslength ss))
    
25.     (setq LST (cons (ssname SS (setq N (1- N))) LST))
    
26.   )
    
27.   (mapcar
    
28.     '(lambda (en)
    
29.        (setq ent (entget en)
    
30.              str (cdr (assoc 1 ent))
    
31.        )
    
32.        (if (and (vl-string-search "/" str) (vl-string-search " " str))
    
33.          (entmod (subst (cons 1 (ykgcl str)) (assoc 1 ent) ent))
    
34.          (if (vl-string-search "/" str)
    
35.            (entmod (subst (cons 1 (wkgcl str)) (assoc 1 ent) ent))
    
36.          )
    
37.        )
    
38.      )
    
39.     lst
    
40.   )
    
41.   (princ)
    
42. )

(vl-load-com)<br /> (defun c:test1 (/ ss n lst str)<br />   (defun wkgcl (str / lst)<br />     (while (vl-string-search "/" str)<br />       (setq str (vl-string-subst """" "/" str))<br />     )<br />     (setq str (strcat "("" str "")"))<br />     (setq lst (read str)<br />           lst (reverse lst)<br />     )<br />     (setq lst (mapcar '(lambda (x) (strcat x "/")) lst))<br />     (setq str (vl-string-right-trim "/" (apply 'strcat lst)))<br />   )<br />   (defun ykgcl (str / len i str1 str2)<br />     (setq len  (strlen str)<br />           i    (vl-string-search " " str)<br />           str1 (substr str 1 (1+ i))<br />           str2 (substr str (+ i 2))<br />     )<br />     (setq str (strcat str1 (wkgcl str2)))<br />   )<br />   (setq ss (ssget '((0 . "text"))))<br />   (repeat (setq N (sslength ss))<br />     (setq LST (cons (ssname SS (setq N (1- N))) LST))<br />   )<br />   (mapcar<br />     '(lambda (en)<br />        (setq ent (entget en)<br />              str (cdr (assoc 1 ent))<br />        )<br />        (if (and (vl-string-search "/" str) (vl-string-search " " str))<br />          (entmod (subst (cons 1 (ykgcl str)) (assoc 1 ent) ent))<br />          (if (vl-string-search "/" str)<br />            (entmod (subst (cons 1 (wkgcl str)) (assoc 1 ent) ent))<br />          )<br />        )<br />      )<br />     lst<br />   )<br />   (princ)<br /> )

试试这个

夏生生

2. (defun c:test1 (/ en ent str n len i str1 str2)
   
3.   (while (and (setq en (car (entsel)))
   
4.               (= "TEXT" (cdr (assoc 0 (setq ent (entget en)))))
   
5.               (setq n (vl-string-search "/" (setq str (cdr (assoc 1 ent)))))
   
6.          )
   
7.     (setq len  (strlen str)
   
8.           i    (vl-string-search " " str)
   
9.           str1 (substr str (+ n 2))
   
10.           str2 (substr str (+ i 2) (- n i 1))
    
11.           str (strcat (substr str 1 i) " " str1 "/" str2)
    
12.     )
    
13.     (entmod (subst(cons 1 str)(assoc 1 ent) ent))
    
14.   )
    
15. )

(defun c:test1 (/ en ent str n len i str1 str2)<br />   (while (and (setq en (car (entsel)))<br />               (= "TEXT" (cdr (assoc 0 (setq ent (entget en)))))<br />               (setq n (vl-string-search "/" (setq str (cdr (assoc 1 ent)))))<br />          )<br />     (setq len  (strlen str)<br />           i    (vl-string-search " " str)<br />           str1 (substr str (+ n 2))<br />           str2 (substr str (+ i 2) (- n i 1))<br />           str (strcat (substr str 1 i) " " str1 "/" str2)<br />     )<br />     (entmod (subst(cons 1 str)(assoc 1 ent) ent))<br />   )<br /> )

对于两排以上,由于一般来讲仅第一或最后一排不同，故本程序亦可处理，对于第一排移至最后一排点一次，对于最后一排移至第一排点排数次

1981yyzz

运行了一下程序，这里还有几个问题。
1.程序中斜杠前后没数字就不起效果，能不能调整为不管斜杠前后是什么都互换，
   即不仅能将6D25 4/2改为6D25 2/4,也能将6D25/2D22变为2D22/6D25
2.能不能满足一次选择无论几排钢筋都能互换，比如6D25/6D22/2D22改为2D22/6D22/6D25
3.程序只能选择一个改一个，能不能框选后全部修改？

q3_2006

1981yyzz 发表于 2014-9-5 20:54
运行了一下程序，这里还有几个问题。
1.程序中斜杠前后没数字就不起效果，能不能调整为不管斜杠前后是什么 ...

如果有3个/怎么调换...??

夏生生

前面写那个原理都有了，步骤也比较清晰，自己稍微修改一下就行

nzl1116

1. (defun AYL-DivideString  (Str Sep / Sub Lst)
   
2.   (setq Sub "")
   
3.   (while (= (substr Str 1 1) Sep)
   
4.     (setq Sub (strcat Sub Sep))
   
5.     (setq Str (substr Str 2))
   
6.   )
   
7.   (if (= Sub "")
   
8.     (setq Lst nil)
   
9.     (setq Lst (list Sub))
   
10.   )
    
11.   (while (setq val (vl-string-search Sep Str))
    
12.     (setq Lst (cons (substr Str 1 Val) Lst))
    
13.     (setq Str (substr Str (1+ Val)))
    
14.     (setq Sub "")
    
15.     (while (= (substr Str 1 1) Sep)
    
16.       (setq Sub (strcat Sub Sep))
    
17.       (setq Str (substr Str 2))
    
18.     )
    
19.     (setq Lst (cons Sub Lst))
    
20.   )
    
21.   (or (= Str "") (setq Lst (cons Str Lst)))
    
22.   Lst
    
23. )
    
24. 
    
25. (defun AYL-ssClist (ss / EnLst n)
    
26.   (setq EnLst nil)
    
27.   (repeat (setq n (sslength ss))
    
28.     (setq EnLst (cons (ssname ss (setq n (1- n))) EnLst))
    
29.   )
    
30. )
    
31. 
    
32. (defun AYL-FixedString (Str / Lst1 Lst2)
    
33.   (setq Lst0 (AYL-DivideString Str " ") Lst1 nil)
    
34.   (while (setq Item (car Lst0))
    
35.     (setq Lst0 (cdr Lst0))
    
36.     (setq Lst2 (AYL-DivideString Item "/"))
    
37.     (setq Lst1 (append Lst2 Lst1))
    
38.   )
    
39.   (apply 'strcat Lst1)
    
40. )
    
41. ;|
    
42. (defun c:test (/ en ent str)
    
43.   (while (setq en (car (entsel)))
    
44.     (and (= "TEXT" (cdr (assoc 0 (setq ent (entget en)))))
    
45.    (setq str (AYL-FixedString (cdr (assoc 1 ent))))
    
46.    (entmod (subst (cons 1 str) (assoc 1 ent) ent))
    
47.     )
    
48.   )
    
49.   (princ)
    
50. )
    
51. |;
    
52. (defun c:tt (/ EntLst)
    
53.   (if (setq ss (ssget '((0 . "*Text"))))
    
54.     (progn
    
55.       (setq EntLst (AYL-ssClist ss)
    
56.       ss     nil
    
57.       )
    
58.       (mapcar
    
59.   (function
    
60.     (lambda (x / a b)
    
61.       (setq a (entget x)
    
62.       b (assoc 1 a)
    
63.       )
    
64.       (entmod (subst (cons 1 (AYL-FixedString (cdr b))) b a))
    
65.     )
    
66.   )
    
67.   EntLst
    
68.       )
    
69.     )
    
70.   )
    
71.   (princ)
    
72. )

(defun AYL-DivideString  (Str Sep / Sub Lst)<br />   (setq Sub "")<br />   (while (= (substr Str 1 1) Sep)<br />     (setq Sub (strcat Sub Sep))<br />     (setq Str (substr Str 2))<br />   )<br />   (if (= Sub "")<br />     (setq Lst nil)<br />     (setq Lst (list Sub))<br />   )<br />   (while (setq val (vl-string-search Sep Str))<br />     (setq Lst (cons (substr Str 1 Val) Lst))<br />     (setq Str (substr Str (1+ Val)))<br />     (setq Sub "")<br />     (while (= (substr Str 1 1) Sep)<br />       (setq Sub (strcat Sub Sep))<br />       (setq Str (substr Str 2))<br />     )<br />     (setq Lst (cons Sub Lst))<br />   )<br />   (or (= Str "") (setq Lst (cons Str Lst)))<br />   Lst<br /> )<br /> <br /> (defun AYL-ssClist (ss / EnLst n)<br />   (setq EnLst nil)<br />   (repeat (setq n (sslength ss))<br />     (setq EnLst (cons (ssname ss (setq n (1- n))) EnLst))<br />   )<br /> )<br /> <br /> (defun AYL-FixedString (Str / Lst1 Lst2)<br />   (setq Lst0 (AYL-DivideString Str " ") Lst1 nil)<br />   (while (setq Item (car Lst0))<br />     (setq Lst0 (cdr Lst0))<br />     (setq Lst2 (AYL-DivideString Item "/"))<br />     (setq Lst1 (append Lst2 Lst1))<br />   )<br />   (apply 'strcat Lst1)<br /> )<br /> ;|<br /> (defun c:test (/ en ent str)<br />   (while (setq en (car (entsel)))<br />     (and (= "TEXT" (cdr (assoc 0 (setq ent (entget en)))))<br />    (setq str (AYL-FixedString (cdr (assoc 1 ent))))<br />    (entmod (subst (cons 1 str) (assoc 1 ent) ent))<br />     )<br />   )<br />   (princ)<br /> )<br /> |;<br /> (defun c:tt (/ EntLst)<br />   (if (setq ss (ssget '((0 . "*Text"))))<br />     (progn<br />       (setq EntLst (AYL-ssClist ss)<br />       ss     nil<br />       )<br />       (mapcar<br />   (function<br />     (lambda (x / a b)<br />       (setq a (entget x)<br />       b (assoc 1 a)<br />       )<br />       (entmod (subst (cons 1 (AYL-FixedString (cdr b))) b a))<br />     )<br />   )<br />   EntLst<br />       )<br />     )<br />   )<br />   (princ)<br /> )

1981yyzz

感谢夏生生和nzl1116两位前辈的解答。

78946299

留个脚印，记录下。后续可能用得到

金鹅起飞

感谢nzl1116大师的源码，为您点赞！