求一增减字符括号的功能

无惢

3个功能：
1.能给字符串加外括号，继续点击能删外括号。
2.能给字符加外括号，继续点击能删除所有外括号。
3.直接删除所有外括号。

pzweng

1. ;;;前后分别加"(" ")"
   
2. (defun C:test1 (/ ss)
   
3.   (defun LM:ss->vla        (ss)
   
4.         ;;->Lee Mac 2010
   
5.         (if        ss
   
6.           ((lambda (i / e l)
   
7.                  (while        (setq e (ssname ss (setq i (1+ i))))
   
8.                    (setq l (cons (vlax-ename->vla-object e) l))
   
9.                  )
   
10.                  l
    
11.            )
    
12.                 -1
    
13.           )
    
14.         )
    
15.   )
    
16.   (setq ss (ssget '((0 . "TEXT"))))
    
17.   (setq ss (LM:ss->vla ss))
    
18.   (mapcar
    
19.         '(lambda (x / str)
    
20.            (setq str (vl-string-right-trim " " (vla-get-TextString x)))
    
21.            (setq str (vl-string-left-trim " " str))
    
22.            (vla-put-TextString x (strcat "(" str ")"))
    
23.          )
    
24.         ss
    
25.   )
    
26.   (princ)
    
27. )
    
28. ;;;前后分别删"(" ")"
    
29. (defun C:test2 (/ ss)
    
30.   (defun LM:ss->vla        (ss)
    
31.         ;;->Lee Mac 2010
    
32.         (if        ss
    
33.           ((lambda (i / e l)
    
34.                  (while        (setq e (ssname ss (setq i (1+ i))))
    
35.                    (setq l (cons (vlax-ename->vla-object e) l))
    
36.                  )
    
37.                  l
    
38.            )
    
39.                 -1
    
40.           )
    
41.         )
    
42.   )
    
43.   (setq ss (ssget '((0 . "TEXT"))))
    
44.   (setq ss (LM:ss->vla ss))
    
45.   (mapcar
    
46.         '(lambda (x / str)
    
47.            (setq str (vl-string-right-trim " " (vla-get-TextString x)))
    
48.            (setq str (vl-string-left-trim " " str))
    
49.            (if (= (substr str 1 1) "(")
    
50.                  (setq str (substr str 2 (1- (strlen str))))
    
51.            )
    
52.            (if (= (substr str (strlen str) 1) ")")
    
53.                  (setq str (substr str 1 (1- (strlen str))))
    
54.            )
    
55.            (vla-put-TextString x str)
    
56.          )
    
57.         ss
    
58.   )
    
59.   (princ)
    
60. )
    
61. 
    
62. ;;;删除所有"(" ")"
    
63. (defun C:test3 (/ ss)
    
64.   (defun LM:ss->vla        (ss)
    
65.         ;;->Lee Mac 2010
    
66.         (if        ss
    
67.           ((lambda (i / e l)
    
68.                  (while        (setq e (ssname ss (setq i (1+ i))))
    
69.                    (setq l (cons (vlax-ename->vla-object e) l))
    
70.                  )
    
71.                  l
    
72.            )
    
73.                 -1
    
74.           )
    
75.         )
    
76.   )
    
77.   (setq ss (ssget '((0 . "TEXT"))))
    
78.   (setq ss (LM:ss->vla ss))
    
79.   (mapcar
    
80.         '(lambda (x / str)
    
81.           (setq str (vl-string->list  (vla-get-TextString x)))  
    
82.            (setq str (vl-remove-if '(lambda(x) (or (= x 40)(= 41 x))) str))
    
83.            (setq str (vl-list->string  str))
    
84.            (vla-put-TextString x str)
    
85.          )
    
86.         ss
    
87.   )
    
88.   (princ)
    
89. )

;;;前后分别加"(" ")"<br /> (defun C:test1 (/ ss)<br />   (defun LM:ss->vla        (ss)<br />         ;;->Lee Mac 2010<br />         (if        ss<br />           ((lambda (i / e l)<br />                  (while        (setq e (ssname ss (setq i (1+ i))))<br />                    (setq l (cons (vlax-ename->vla-object e) l))<br />                  )<br />                  l<br />            )<br />                 -1<br />           )<br />         )<br />   )<br />   (setq ss (ssget '((0 . "TEXT"))))<br />   (setq ss (LM:ss->vla ss))<br />   (mapcar<br />         '(lambda (x / str)<br />            (setq str (vl-string-right-trim " " (vla-get-TextString x)))<br />            (setq str (vl-string-left-trim " " str))<br />            (vla-put-TextString x (strcat "(" str ")"))<br />          )<br />         ss<br />   )<br />   (princ)<br /> )<br /> ;;;前后分别删"(" ")"<br /> (defun C:test2 (/ ss)<br />   (defun LM:ss->vla        (ss)<br />         ;;->Lee Mac 2010<br />         (if        ss<br />           ((lambda (i / e l)<br />                  (while        (setq e (ssname ss (setq i (1+ i))))<br />                    (setq l (cons (vlax-ename->vla-object e) l))<br />                  )<br />                  l<br />            )<br />                 -1<br />           )<br />         )<br />   )<br />   (setq ss (ssget '((0 . "TEXT"))))<br />   (setq ss (LM:ss->vla ss))<br />   (mapcar<br />         '(lambda (x / str)<br />            (setq str (vl-string-right-trim " " (vla-get-TextString x)))<br />            (setq str (vl-string-left-trim " " str))<br />            (if (= (substr str 1 1) "(")<br />                  (setq str (substr str 2 (1- (strlen str))))<br />            )<br />            (if (= (substr str (strlen str) 1) ")")<br />                  (setq str (substr str 1 (1- (strlen str))))<br />            )<br />            (vla-put-TextString x str)<br />          )<br />         ss<br />   )<br />   (princ)<br /> )<br /> <br /> ;;;删除所有"(" ")"<br /> (defun C:test3 (/ ss)<br />   (defun LM:ss->vla        (ss)<br />         ;;->Lee Mac 2010<br />         (if        ss<br />           ((lambda (i / e l)<br />                  (while        (setq e (ssname ss (setq i (1+ i))))<br />                    (setq l (cons (vlax-ename->vla-object e) l))<br />                  )<br />                  l<br />            )<br />                 -1<br />           )<br />         )<br />   )<br />   (setq ss (ssget '((0 . "TEXT"))))<br />   (setq ss (LM:ss->vla ss))<br />   (mapcar<br />         '(lambda (x / str)<br />           (setq str (vl-string->list  (vla-get-TextString x)))  <br />            (setq str (vl-remove-if '(lambda(x) (or (= x 40)(= 41 x))) str))<br />            (setq str (vl-list->string  str))<br />            (vla-put-TextString x str)<br />          )<br />         ss<br />   )<br />   (princ)<br /> )

无惢

最好能连续操作

叮咚

不动脑子
vl-vlax-ename->vla-object
vl-string-subst
vl-string-position
这几个函数就行了

无惢

期待无聊大师，没事写写

无惢

pzweng 发表于 2013-5-14 09:24

没达到想要的效果。但没人回，最佳答案就你了

无惢

500w008 发表于 2013-8-22 04:34

这是上面程序测试效果？ 我没仔细测试过。。。看没人回就选择最佳了。。。