明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1890|回复: 5

[源码] 帮忙看一下删括号的程序

[复制链接]
发表于 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))
  )
)


"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2011-12-13 18:51:31 | 显示全部楼层
来个大师吧
发表于 2011-12-13 18:59:17 | 显示全部楼层
直接批量删前后缀就有现成的,这个也值得研究下
发表于 2011-12-13 19:04:41 | 显示全部楼层
我记得删除括弧不用这么复杂吧?有一个函数vl-string-trim可以一下子删除前后缀哦
发表于 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)
)
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-5-23 11:32 , Processed in 0.157678 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表