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

lengliqun

从含有K1的长字符串中提取其括号及括号内的字符如(2)
作为后缀加到其它对应的短字符串如K1后,使K1变成K1(2)
附件含DWG图，意思表达更明了，请下载附件。谢谢。

它山之石

这种偶然才会遇到的问题不必要写程序吗？
你用CAD的的替换就完全可以达到你的要求了。

lengliqun

不是的啦，我的每个工程平面图都要如此处理，且每张有许多个特征字符串Ki 都要如此相同处理，可烦了，高手帮帮忙啦。先谢了。

zxq0220

最初由 lengliqun 发布
[B]从含有K1的长字符串中提取其括号及括号内的字符如(2)
作为后缀加到其它对应的短字符串如K1后,使K1变成K1(2)
附件含DWG图，意思表达更明了，请下载附件。谢谢。 [/B]

楼主想要的程序（未经调试）：

2. 
   
3. (DEFUN C:ADDPOST ()
   
4. (IF (SETQ SN (CAR (ENTSEL "\nPlease Select a Text 请选择文本 :"))) (PROGN
   
5.   (SETQ EN (ENTGET SN)
   
6.         STR (CDR (ASSOC 1 EN))
   
7.         STL (STRLEN STR)
   
8.         J 1 JJ -1)
   
9.   (WHILE (< J STL)
   
10.    (IF (= (SUBSTR STR J 1) "(")
    
11.     (SETQ JJ J J STL)
    
12.     (SETQ J (1+ J))
    
13.    )
    
14.   )
    
15.   (IF (> JJ 0) (PROGN
    
16.    (SETQ STR1 (SUBSTR STR 1 (1- J))
    
17.          J JJ J1 JJ)
    
18.    (WHILE (< J STL)
    
19.     (IF (= (SUBSTR STR J 1) ")")
    
20.      (SETQ JJ J J STL)
    
21.      (SETQ J (1+ J))
    
22.     )
    
23.    )
    
24.    (SETQ STR2 (SUBSTR STR J1 (- JJ J1)))
    
25.    (PRINC "\nSelect Text(s) That You Want to Change 请选择要更改的文本 :")
    
26.    (IF (SETQ SS (SSGET '((0 . "TEXT")))) (PROGN
    
27.     (SETQ I 0 SL (SSLENGTH SS))
    
28.     (REPEAT SL
    
29.      (SETQ EN (ENTGET (SSNAME SS I))
    
30.            I (1+ I)
    
31.            STR (CDR (ASSOC 1 EN)))
    
32.      (IF (= STR STR1) (PROGN
    
33.       (SETQ STR3 (STRCAT STR STR2)
    
34.             EN (SUBST (CONS 1 STR3) (CONS 1 STR) EN))
    
35.       (ENTMOD EN)
    
36.      ))
    
37.     )
    
38.    ))
    
39.   ))
    
40. ))
    
41. (PRINC)
    
42. )
    

<br /> (DEFUN C:ADDPOST ()<br /> (IF (SETQ SN (CAR (ENTSEL "\nPlease Select a Text 请选择文本 :"))) (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- J))<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)))<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 /> ))<br /> (PRINC)<br /> )<br />

lengliqun

以上程序只可单选，且运行后毫无动静，zxq0220 老大能否下载一楼附件调试一下？

xyp1964

[php]
;;;加载通用函数
;;;下载：http://www.xdcad.net/forum/showthread.php?s=&threadid=325268
(load "xyp_lib")

(defun c:test (/ txt ss i tva)
  (cmdla0)
  (command ".undo" "BE")
  (setq        txt1 (ustr 1 "\n输入括号内字符串" txt1 nil)
        txt  (strcat "(" txt1 ")")
  )
  (setq        SS (ssget '((0 . "TEXT")))
        i  -1
  )
  (while (setq s1 (ssname ss (setq i (1+ i))))
    (setq tva (dxf 1 (entget s1))
          tva (strcat tva txt)
    )
    (sub_upd s1 1 tva)
  )
  (command ".undo" "E")
  (cmdla0)
)
[/php]

eachy

(ssget (list (cons 1 (strcat "K(" str1 ")")))) 后面选择用过滤可以提高效率。

lengliqun

xyp1964 的程序可以运行，但得到并非想要结果，请zxyp1964  老大下载一楼附件调试一下？

zxq0220

调试通过的代码：
[php]
(DEFUN C:ADDPOST ()
(IF (SETQ SN (CAR (ENTSEL "\nPlease Select a Text 请选择带括弧的文本 :"))) (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)
     ))
    )
   ))
  ))
))
(PRINC)
)
[/php]

xyp1964

最初由 lengliqun 发布
[B]xyp1964 的程序可以运行，但得到并非想要结果，请zxyp1964  老大下载一楼附件调试一下？ [/B]

没加字长判断，所以不能乱选，否则会出错！

lengliqun

9楼zxq0220 程序可用，谢谢。我再加个要求： 增加   默认全选   功能。
Please Select a Text 请选择带括弧的文本<默认全选> :

li809

最初由 xyp1964 发布
[B]
没加字长判断，所以不能乱选，否则会出错！ [/B]

能否完善你的程序，谢谢

zxq0220

最初由 lengliqun 发布
[B]9楼zxq0220 程序可用，谢谢。我再加个要求： 增加   默认全选   功能。
Please Select a Text 请选择带括弧的文本<默认全选> : [/B]

楼主的要求真多呀！下面的程序未经调试，请楼主自行调试一下。
[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 SS 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 SS 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]

lengliqun

TO：zxq0220
不好意思，是我弄错了，应是这样的：

Please Select a Text 请选择带括弧的文本:
Select Text(s) That You Want to Change 请选择要更改的文本＜全选＞ :

这样每次我就不用输入　　ALL　　了

zxq0220

最初由 lengliqun 发布
[B]TO：zxq0220
不好意思，是我弄错了，应是这样的：

Please Select a Text 请选择带括弧的文本:
Select Text(s) That You Want to Change 请选择要更改的文本＜全选＞ :

这样每次我就不用输入　　ALL　　了 [/B]

您试过上面的程序吗？
上面的程序如果第一个问题用空回车回答，
则全自动对图样中的文本进行处理。
下面是再次修改的程序：
[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 请选择要更改的文本<全选> :")
   (SETQ SS (SSGET '((0 . "TEXT"))))
   (IF (= SS nil) (SETQ SS (SSGET "X" '((0 . "TEXT")))))
   (IF (/= SS nil) (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)
     ))
    )
   ))
  ))
))
(PRINC)
)
[/php]