[分享]：【实用程序汇总】test000系列！

曹杰

请问版主的加括号功能能否再增加一个删除括号的功能

啵浪鼓

哇,好,楼主辛苦了,支持一下

xyp1964

最初由 曹杰 发布
[B]请问版主的加括号功能能否再增加一个删除括号的功能 [/B]

试试：
[PHP];;;删除前后缀括号
;;;前缀支持：([{<（｛〔《「『〖【
;;;后缀支持：)]}>）｝〕》」』〗】
(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))
  )
)[/PHP]

hi71400

突然感到,很多人做了很多很多重复的编程,浪费了大量大量的精力!!
希望:有誰能将一部分自愿者组织起来,成立专栏组,制定方向,安排谁谁谁编写什么什么,这样才有前途!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

砼皮铁骨

非常有用的程序.谢谢楼主.

sxlxf

下了,试用中.谢谢

曹杰

谢谢楼主，你的程序都很实用

死亡沙漠

2002可以加载吗

coffeejhr

慢慢研究，呵呵！谢谢！

狂刀

;;;删除所有括号
;;;支持：([{<（｛〔《「『〖【 )]}>）｝〕》」』〗】
;;;(tt "『】12>4】我《们 测』试》" ) ;;->"124我们 测试"
[php]
(defun tt (str)
  (mapcar '(lambda (x)
             (while (vl-string-search x str)
               (setq str (vl-string-subst "" x str))
             )
           )
          '("(" "[" "{" "<" "（" "｛" "〔" "《" "「" "『" "〖" "【"
            ")" "]" "}" ">" "）" "｝" "〕" "》"        "」" "』" "〗" "】"
           )
  )str
)[/php]
;;;删除前后缀括号
;;;前缀支持：([{<（｛〔《「『〖【
;;;后缀支持：)]}>）｝〕》」』〗】
;;;(tt2 "『12>4】我《们 测』试》" ) ;;->"12>4】我《们 测』试"
;;;(tt2 "{12>4】我《们 测』试]" ) ;;->"12>4】我《们 测』试"
;;;(tt2 "{12>4】我《们 测』试》" ) ;;->"12>4】我《们 测』试"
[php]
(defun tt2 (str / pre1 pre2 pos1 pos2 n)
  (setq pre1 '("(" "[" "{" "<")
        pre2 '("（" "｛" "〔" "《" "「" "『" "〖" "【")
        pos1 '(")" "]" "}" ">" )
        pos2 '("）" "｝" "〕" "》" "」" "』" "〗" "】"))
  (or (if (member (substr str 1 1) pre1)(setq str (substr str 2)) nil)
      (if (member (substr str 1 2) pre2)(setq str (substr str 3)) nil)
      )
  (setq n (strlen str))
  (or (if (member (substr str n) pos1)(setq str (substr str 1 (- n 1))) nil)
      (if (member (substr str (- n 1)) pos2)(setq str (substr str 1 (- n 2))) nil)
      )
  str
)
[/php]

xyp1964

最初由 狂刀 发布
[B];;;删除所有括号
;;;支持：([{<（｛〔《「『〖【 )]}>）｝〕》」』〗】
;;;(tt "『】12>4】我《们 测』试》" ) ;;->"124我们 测试"
[php]
(defun tt (str)
  (mapcar '(lambda (x)
             (while (vl-string-... [/B]

此程序收币可能不合适！呵呵……


★ 主题程序已增加到70个，可到1、2楼下载。

它山之石

最初由 hi71400 发布
[B]突然感到,很多人做了很多很多重复的编程,浪费了大量大量的精力!!
希望:有誰能将一部分自愿者组织起来,成立专栏组,制定方向,安排谁谁谁编写什么什么,这样才有前途!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!... [/B]

是啊，看看AutoCAD、天正、理正、探索者、圆方的程序员多有前途。呵呵。

xyp1964

需要热心者或领导者搜集整理或组织程序、编程。

li809

我也收集了一些好用程序,待整理后上传分享

ydf7332462

多重实体过滤的程序,几次都不了了之,能否编一?