[编程申请]：(高难度)从含有K1的长字符串中提取其括号及括号内的字符如(2)

lengliqun

经测试15楼程序完全可用，谢谢。13楼的LSP能全自动处理吗？那当然更好了，省得我每个含括号的特征字符串都要点选一下(每张图几十下)，可13楼的LSP我回空车后，毫无动静(win2000+acad2002)。不好意思地说一下，我是个程序盲，只会加载使用一下，不会调试修改，zxq0220 大侠已帮了我很多忙，谢谢了，期待您的再次出手。

zxq0220

调试过的13楼程序:
[php]
(DEFUN C:ADDPOST ()
(SETQ SN (CAR (ENTSEL "\nPlease Select a Text 请选择带括弧的文本<全选> :")))
(IF (/= SN nil) (PROGN
  (SETQ EN (ENTGET SN)
        STR (CDR (ASSOC 1 EN))
        STL (STRLEN STR)
        J 1 JJ -1)
  (WHILE (< J STL)
   (IF (= (SUBSTR STR J 1) "(")
    (SETQ JJ J J STL)
    (SETQ J (1+ J))
   )
  )
  (IF (> JJ 0) (PROGN
   (SETQ STR1 (SUBSTR STR 1 (1- JJ))
         J JJ J1 JJ)
   (WHILE (< J STL)
    (IF (= (SUBSTR STR J 1) ")")
     (SETQ JJ J J STL)
     (SETQ J (1+ J))
    )
   )
   (SETQ STR2 (SUBSTR STR J1 (- JJ J1 -1)))
   (PRINC "\nSelect Text(s) That You Want to Change 请选择要更改的文本 :")
   (IF (SETQ SS (SSGET '((0 . "TEXT")))) (PROGN
    (SETQ I 0 SL (SSLENGTH SS))
    (REPEAT SL
     (SETQ EN (ENTGET (SSNAME SS I))
           I (1+ I)
           STR (CDR (ASSOC 1 EN)))
     (IF (= STR STR1) (PROGN
      (SETQ STR3 (STRCAT STR STR2)
            EN (SUBST (CONS 1 STR3) (CONS 1 STR) EN))
      (ENTMOD EN)
     ))
    )
   ))
  ))
) (PROGN
(SETQ SS1 (SSGET "X" '((0 . "TEXT") (1 . "*(*)*")))
       I 0 SL (SSLENGTH SS1))
(REPEAT SL
  (SETQ STR (CDR (ASSOC 1 (ENTGET (SSNAME SS1 I))))
        I (1+ I)
        STL (STRLEN STR) J 1 JJ -1)
  (WHILE (< J STL)
   (IF (= (SUBSTR STR J 1) "(")
    (SETQ JJ J J STL)
    (SETQ J (1+ J))
   )
  )
  (IF (> JJ 0) (PROGN
   (SETQ STR1 (SUBSTR STR 1 (1- JJ))
         J JJ J1 JJ)
   (WHILE (< J STL)
    (IF (= (SUBSTR STR J 1) ")")
     (SETQ JJ J J STL)
     (SETQ J (1+ J))
    )
   )
   (SETQ STR2 (SUBSTR STR J1 (- JJ J1 -1)))
   (IF (SETQ SS2 (SSGET "X" (LIST (CONS 0 "TEXT") (CONS 1 STR1)))) (PROGN
    (SETQ K 0 SSL (SSLENGTH SS2))
    (REPEAT SSL
     (SETQ EN (ENTGET (SSNAME SS2 K))
           K (1+ K)
           STR (CDR (ASSOC 1 EN)))
     (IF (= STR STR1) (PROGN
      (SETQ STR3 (STRCAT STR STR2)
            EN (SUBST (CONS 1 STR3) (CONS 1 STR) EN))
      (ENTMOD EN)
     ))
    )
   ))
  ))
)
))
(PRINC)
)
[/php]

无痕

全选的时候，楼上程序对例图 的 k2  k4结果错误

lengliqun

经500多个字符串测试,17楼LSP全选的时候完美可用，对例图 的 k2 k4结果错误 可能因图中隐藏字符.

zxq0220

经进一步调试通过

2. 
   
3. (DEFUN C:ADDPOST ()
   
4. (SETQ SN (CAR (ENTSEL "\nPlease Select a Text 请选择带括弧的文本<全选> :")))
   
5. (IF (/= SN nil) (PROGN
   
6.   (SETQ EN (ENTGET SN)
   
7.         STR (CDR (ASSOC 1 EN))
   
8.         STL (STRLEN STR)
   
9.         J 1 JJ -1)
   
10.   (WHILE (< J STL)
    
11.    (IF (= (SUBSTR STR J 1) "(")
    
12.     (SETQ JJ J J STL)
    
13.     (SETQ J (1+ J))
    
14.    )
    
15.   )
    
16.   (IF (> JJ 0) (PROGN
    
17.    (SETQ STR1 (SUBSTR STR 1 (1- JJ))
    
18.          J JJ J1 JJ)
    
19.    (WHILE (< J STL)
    
20.     (IF (= (SUBSTR STR J 1) ")")
    
21.      (SETQ JJ J J STL)
    
22.      (SETQ J (1+ J))
    
23.     )
    
24.    )
    
25.    (SETQ STR2 (SUBSTR STR J1 (- JJ J1 -1)))
    
26.    (PRINC "\nSelect Text(s) That You Want to Change 请选择要更改的文本 :")
    
27.    (IF (SETQ SS (SSGET '((0 . "TEXT")))) (PROGN
    
28.     (SETQ I 0 SL (SSLENGTH SS))
    
29.     (REPEAT SL
    
30.      (SETQ EN (ENTGET (SSNAME SS I))
    
31.            I (1+ I)
    
32.            STR (CDR (ASSOC 1 EN)))
    
33.      (IF (= STR STR1) (PROGN
    
34.       (SETQ STR3 (STRCAT STR STR2)
    
35.             EN (SUBST (CONS 1 STR3) (CONS 1 STR) EN))
    
36.       (ENTMOD EN)
    
37.      ))
    
38.     )
    
39.    ))
    
40.   ))
    
41. ) (PROGN
    
42. (SETQ SS1 (SSGET "X" '((0 . "TEXT") (1 . "*(*)*")))
    
43.        I 0 SL (SSLENGTH SS1))
    
44. (REPEAT SL
    
45.   (SETQ STR (CDR (ASSOC 1 (ENTGET (SSNAME SS1 I))))
    
46.         I (1+ I)
    
47.         STL (STRLEN STR) J 1 JJ -1)
    
48.   (WHILE (< J STL)
    
49.    (IF (= (SUBSTR STR J 1) "(")
    
50.     (SETQ JJ J J STL)
    
51.     (SETQ J (1+ J))
    
52.    )
    
53.   )
    
54.   (IF (> JJ 0) (PROGN
    
55.    (SETQ STR1 (SUBSTR STR 1 (1- JJ))
    
56.          J JJ J1 JJ)
    
57.    (WHILE (< J STL)
    
58.     (IF (= (SUBSTR STR J 1) ")")
    
59.      (SETQ JJ J J STL)
    
60.      (SETQ J (1+ J))
    
61.     )
    
62.    )
    
63.    (SETQ STR2 (SUBSTR STR J1 (IF (= JJ J1) (- J J1 -1) (- JJ J1 -1))))
    
64.    (IF (SETQ SS2 (SSGET "X" (LIST (CONS 0 "TEXT") (CONS 1 STR1)))) (PROGN
    
65.     (SETQ K 0 SSL (SSLENGTH SS2))
    
66.     (REPEAT SSL
    
67.      (SETQ EN (ENTGET (SSNAME SS2 K))
    
68.            K (1+ K)
    
69.            STR (CDR (ASSOC 1 EN)))
    
70.      (IF (= STR STR1) (PROGN
    
71.       (SETQ STR3 (STRCAT STR STR2)
    
72.             EN (SUBST (CONS 1 STR3) (CONS 1 STR) EN))
    
73.       (ENTMOD EN)
    
74.      ))
    
75.     )
    
76.    ))
    
77.   ))
    
78. )
    
79. ))
    
80. (PRINC)
    
81. )
    

<br /> (DEFUN C:ADDPOST ()<br /> (SETQ SN (CAR (ENTSEL "\nPlease Select a Text 请选择带括弧的文本<全选> :")))<br /> (IF (/= SN nil) (PROGN <br />   (SETQ EN (ENTGET SN)<br />         STR (CDR (ASSOC 1 EN))<br />         STL (STRLEN STR)<br />         J 1 JJ -1)<br />   (WHILE (< J STL)<br />    (IF (= (SUBSTR STR J 1) "(")<br />     (SETQ JJ J J STL)<br />     (SETQ J (1+ J))<br />    )<br />   )<br />   (IF (> JJ 0) (PROGN<br />    (SETQ STR1 (SUBSTR STR 1 (1- JJ))<br />          J JJ J1 JJ)<br />    (WHILE (< J STL)<br />     (IF (= (SUBSTR STR J 1) ")")<br />      (SETQ JJ J J STL)<br />      (SETQ J (1+ J))<br />     )<br />    )<br />    (SETQ STR2 (SUBSTR STR J1 (- JJ J1 -1)))<br />    (PRINC "\nSelect Text(s) That You Want to Change 请选择要更改的文本 :")<br />    (IF (SETQ SS (SSGET '((0 . "TEXT")))) (PROGN<br />     (SETQ I 0 SL (SSLENGTH SS))<br />     (REPEAT SL<br />      (SETQ EN (ENTGET (SSNAME SS I))<br />            I (1+ I)<br />            STR (CDR (ASSOC 1 EN)))<br />      (IF (= STR STR1) (PROGN<br />       (SETQ STR3 (STRCAT STR STR2)<br />             EN (SUBST (CONS 1 STR3) (CONS 1 STR) EN))<br />       (ENTMOD EN)<br />      ))<br />     )<br />    ))<br />   ))<br /> ) (PROGN<br /> (SETQ SS1 (SSGET "X" '((0 . "TEXT") (1 . "*(*)*")))<br />        I 0 SL (SSLENGTH SS1))<br /> (REPEAT SL<br />   (SETQ STR (CDR (ASSOC 1 (ENTGET (SSNAME SS1 I))))<br />         I (1+ I)<br />         STL (STRLEN STR) J 1 JJ -1)<br />   (WHILE (< J STL)<br />    (IF (= (SUBSTR STR J 1) "(")<br />     (SETQ JJ J J STL)<br />     (SETQ J (1+ J))<br />    )<br />   )<br />   (IF (> JJ 0) (PROGN<br />    (SETQ STR1 (SUBSTR STR 1 (1- JJ))<br />          J JJ J1 JJ)<br />    (WHILE (< J STL)<br />     (IF (= (SUBSTR STR J 1) ")")<br />      (SETQ JJ J J STL)<br />      (SETQ J (1+ J))<br />     )<br />    )<br />    (SETQ STR2 (SUBSTR STR J1 (IF (= JJ J1) (- J J1 -1) (- JJ J1 -1))))<br />    (IF (SETQ SS2 (SSGET "X" (LIST (CONS 0 "TEXT") (CONS 1 STR1)))) (PROGN<br />     (SETQ K 0 SSL (SSLENGTH SS2))<br />     (REPEAT SSL<br />      (SETQ EN (ENTGET (SSNAME SS2 K))<br />            K (1+ K)<br />            STR (CDR (ASSOC 1 EN)))<br />      (IF (= STR STR1) (PROGN<br />       (SETQ STR3 (STRCAT STR STR2)<br />             EN (SUBST (CONS 1 STR3) (CONS 1 STR) EN))<br />       (ENTMOD EN)<br />      ))<br />     )<br />    ))<br />   ))<br /> )<br /> ))<br /> (PRINC)<br /> )<br />

无痕

2. 
   
3. ;| [url]http://www.xdcad.net/forum/showthread.php?postid=1716822#post1716822[/url]
   
4. 从含有K1的长字符串中提取其括号及括号内的字符如(2)
   
5. 作为后缀加到其它对应的短字符串如K1后,使K1变成K1(2)
   
6. |;
   
7. (defun c:akpost ( / a ss i lst ss2 fi ent)
   
8.   (command ".undo" "be")
   
9.   (or (setq a (entsel "\nPlease Select a Text 请选择带括弧的文本<全选> :"))
   
10.       (setq ss (ssget "X" '((0 . "TEXT")(1 . "K*(*)*")))))
    
11.   (setq i -1)
    
12.   (if a
    
13.     (setq lst (list (getpost (car a))))
    
14.     (mapcar '(lambda (x)
    
15.                (if (not (member (setq xx (getpost x)) lst))
    
16.                  (setq lst (cons xx lst))
    
17.                )
    
18.              )
    
19.             (ss2lst ss)
    
20.     )
    
21.   )
    
22.   (mapcar '(lambda(x / ss2 fi)
    
23.              (setq fi (list (cons 0 "TEXT")(cons 1 (strcat "K" (car x)))))
    
24.              (if a
    
25.                (progn
    
26.                  (princ "\nSelect Text(s) That You Want to Change 请选择要更改的文本<全选> :")
    
27.                  (or (setq ss2 (ssget fi))
    
28.                      (setq ss2 (ssget "x" fi))
    
29.                  )
    
30.                )
    
31.                (setq ss2 (ssget "x" fi))
    
32.              )
    
33.              (if ss2
    
34.              (mapcar
    
35.                '(lambda        (y / ent)
    
36.                   (setq ent (entget y))
    
37.                   (entmod
    
38.                     (subst (cons 1 (strcat (cdr (assoc 1 ent)) (cadr x)))
    
39.                            (assoc 1 ent)
    
40.                            ent
    
41.                     )
    
42.                   )
    
43.                 )
    
44.                (ss2lst ss2)
    
45.              ) )
    
46.            )
    
47.            lst
    
48.   )
    
49.   (command ".undo" "e")
    
50.   (princ)
    
51. )
    
52. ;; ss2lst.
    
53. (defun ss2lst (sset / i e elst)
    
54.   (setq i -1)
    
55.   (while (setq e (ssname sset (setq i (1+ i))))
    
56.     (setq elst (cons e elst))
    
57.   );(reverse lst)
    
58. )
    
59. ;; getpost.  (getpost (setq e (car(entsel))))
    
60. (defun getpost (e / ent str n)
    
61.   (setq ent(entget e)
    
62.         str(substr (cdr(assoc 1 ent)) 2 ))
    
63.   (list(substr str 1  (setq n (vl-string-position (ascii "(") str)))
    
64.        (substr str (1+ n) (vl-string-position (ascii ")") str)))
    
65. )
    

<br /> ;| [url]http://www.xdcad.net/forum/showthread.php?postid=1716822#post1716822[/url]<br /> 从含有K1的长字符串中提取其括号及括号内的字符如(2)<br /> 作为后缀加到其它对应的短字符串如K1后,使K1变成K1(2)<br /> |;<br /> (defun c:akpost ( / a ss i lst ss2 fi ent) <br />   (command ".undo" "be")<br />   (or (setq a (entsel "\nPlease Select a Text 请选择带括弧的文本<全选> :"))<br />       (setq ss (ssget "X" '((0 . "TEXT")(1 . "K*(*)*")))))<br />   (setq i -1)<br />   (if a<br />     (setq lst (list (getpost (car a))))<br />     (mapcar '(lambda (x)<br />                (if (not (member (setq xx (getpost x)) lst))<br />                  (setq lst (cons xx lst))<br />                )<br />              )<br />             (ss2lst ss)<br />     )<br />   )<br />   (mapcar '(lambda(x / ss2 fi)<br />              (setq fi (list (cons 0 "TEXT")(cons 1 (strcat "K" (car x)))))<br />              (if a<br />                (progn<br />                  (princ "\nSelect Text(s) That You Want to Change 请选择要更改的文本<全选> :")<br />                  (or (setq ss2 (ssget fi))<br />                      (setq ss2 (ssget "x" fi))<br />                  )<br />                )<br />                (setq ss2 (ssget "x" fi))<br />              )<br />              (if ss2<br />              (mapcar<br />                '(lambda        (y / ent)<br />                   (setq ent (entget y))<br />                   (entmod<br />                     (subst (cons 1 (strcat (cdr (assoc 1 ent)) (cadr x)))<br />                            (assoc 1 ent)<br />                            ent<br />                     )<br />                   )<br />                 )<br />                (ss2lst ss2)<br />              ) )<br />            )<br />            lst<br />   )<br />   (command ".undo" "e")<br />   (princ)<br /> )<br /> ;; ss2lst.<br /> (defun ss2lst (sset / i e elst)<br />   (setq i -1)<br />   (while (setq e (ssname sset (setq i (1+ i))))<br />     (setq elst (cons e elst))<br />   );(reverse lst)<br /> )<br /> ;; getpost.  (getpost (setq e (car(entsel))))<br /> (defun getpost (e / ent str n)<br />   (setq ent(entget e)<br />         str(substr (cdr(assoc 1 ent)) 2 ))<br />   (list(substr str 1  (setq n (vl-string-position (ascii "(") str)))<br />        (substr str (1+ n) (vl-string-position (ascii ")") str)))<br /> )<br />

lengliqun

谢谢，经测试都可以用，谢谢啦。