adc 发表于 2011-5-4 15:07:15

帮忙看一下删括号的程序

本帖最后由 adc 于 2011-5-4 15:08 编辑

麻烦帮忙看看这个删括号的程序有啥问题，谢谢                                                                                                                     ;;;删除前后缀括号
;;;前缀支持：([{<（｛〔《「『〖【
;;;后缀支持：)]}>）｝〕》」』〗】
(defun c:test ()
(cmdla0)
(setq    a1(car (entsel "\n请选择文字 : "))
    str (dxf 1 (entget a1))
)
(setq    l1   (substr str 1 1)
    l2   (substr str 1 2)
    mode 1
)
(vl-cmdf ".undo" "BE")
(while (= mode 1)
    (txtchg-S)
)
(setq    str(dxf 1 (entget a1))
    l    (strlen str)
    l1   (substr str (- l 0) 1)
    l2   (substr str (- l 1) 2)
    mode 1
)
(while (= mode 1)
    (txtchg-E)
)
(vl-cmdf ".undo" "E")
(cmdla1)
)
(defun txtchg-s    ()
(cond    ((or (= l1 "(") (= l1 "[") (= l1 "{") (= l1 "<"))
   (setq str1 (substr str 2))
   (sub_upd a1 1 str1)
   (setq str (dxf 1 (entget a1))
         l1(substr str 1 1)
         l2(substr str 1 2)
   )
   ;|(princ "\nl1 = ")
   (princ l1)
   (princ "\nstr = ")
   (princ str)
   |;
    )
    ((or (= l2 "（")
         (= l2 "〔")
         (= l2 "「")
         (= l2 "『")
         (= l2 "〖")
         (= l2 "【")
         (= l2 "《")
         (= l2 "｛")
   )
   (setq str1 (substr str 3))
   (sub_upd a1 1 str1)
   (setq str (dxf 1 (entget a1))
         l1(substr str 1 1)
         l2(substr str 1 2)
   )
   ;|(princ "\nl2 = ")
   (princ l2)
   (princ "\nstr = ")
   (princ str)
   |;
    )
    (t (setq mode nil))
)
)
(defun txtchg-E    ()
(cond    ((or (= l1 ")") (= l1 "]") (= l1 "}") (= l1 ">"))
   (setq str1 (substr str 1 (- l 1)))
   (sub_upd a1 1 str1)
   (setq str (dxf 1 (entget a1))
         l   (strlen str)
         l1(substr str (- l 0) 1)
         l2(substr str (- l 1) 2)
   )         
    )
    ((or (= l2 "）")
         (= l2 "〕")
         (= l2 "」")
         (= l2 "』")
         (= l2 "〗")
         (= l2 "】")
         (= l2 "》")
         (= l2 "｝")
   )
   (setq str1 (substr str 1 (- l 2)))
   (sub_upd a1 1 str1)
   (setq str (dxf 1 (entget a1))
         l   (strlen str)
         l1(substr str (- l 0) 1)
         l2(substr str (- l 1) 2)
   )   
    )
    (t (setq mode nil))
)
)


zwp1981 发表于 2011-12-13 18:51:31

来个大师吧

【KAIXIN】 发表于 2011-12-13 18:59:17

直接批量删前后缀就有现成的，这个也值得研究下

yjr111 发表于 2011-12-13 19:04:41

我记得删除括弧不用这么复杂吧？有一个函数vl-string-trim可以一下子删除前后缀哦

jxy308 发表于 2015-1-21 09:44:02

这个论坛里面有人写过了

香田里浪人 发表于 2015-1-22 18:38:31

;;;前后分别删"(" ")"
(defun C:skh (/ 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
          )
      )
)
(while
(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)
)
页: [1]
查看完整版本: 帮忙看一下删括号的程序