无惢 发表于 2013-5-14 09:24:44

求一增减字符括号的功能

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

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

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

;;;删除所有"(" ")"
(defun C:test3 (/ ss)
(defun LM:ss->vla      (ss)
      ;;->Lee Mac 2010
      (if      ss
          ((lambda (i / e l)
               (while      (setq e (ssname ss (setq i (1+ i))))
                   (setq l (cons (vlax-ename->vla-object e) l))
               )
               l
         )
                -1
          )
      )
)
(setq ss (ssget '((0 . "TEXT"))))
(setq ss (LM:ss->vla ss))
(mapcar
      '(lambda (x / str)
          (setq str (vl-string->list(vla-get-TextString x)))
         (setq str (vl-remove-if '(lambda(x) (or (= x 40)(= 41 x))) str))
         (setq str (vl-list->stringstr))
         (vla-put-TextString x str)
         )
      ss
)
(princ)
)

无惢 发表于 2013-5-14 09:33:46

最好能连续操作

叮咚 发表于 2013-5-14 20:14:27

本帖最后由 叮咚 于 2013-5-15 08:44 编辑


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

无惢 发表于 2013-5-15 17:54:31

期待无聊大师，没事写写

无惢 发表于 2013-8-18 17:20:46

pzweng 发表于 2013-5-14 09:24 static/image/common/back.gif


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

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

无惢 发表于 2013-8-23 09:18:18

500w008 发表于 2013-8-22 04:34 static/image/common/back.gif

这是上面程序测试效果？ 我没仔细测试过。。。看没人回就选择最佳了。。。
页: [1]
查看完整版本: 求一增减字符括号的功能