明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1680|回复: 7

求一增减字符括号的功能

[复制链接]
发表于 2013-5-14 09:24:44 | 显示全部楼层 |阅读模式
10明经币
3个功能:
1.能给字符串加外括号,继续点击能删外括号。
2.能给字符加外括号,继续点击能删除所有外括号。
3.直接删除所有外括号。

附件: 您需要 登录 才可以下载或查看,没有账号?注册

最佳答案

发表于 2013-5-14 09:24:45 | 显示全部楼层
  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. (defun C:test3 (/ ss)
  63.   (defun LM:ss->vla        (ss)
  64.         ;;->Lee Mac 2010
  65.         (if        ss
  66.           ((lambda (i / e l)
  67.                  (while        (setq e (ssname ss (setq i (1+ i))))
  68.                    (setq l (cons (vlax-ename->vla-object e) l))
  69.                  )
  70.                  l
  71.            )
  72.                 -1
  73.           )
  74.         )
  75.   )
  76.   (setq ss (ssget '((0 . "TEXT"))))
  77.   (setq ss (LM:ss->vla ss))
  78.   (mapcar
  79.         '(lambda (x / str)
  80.           (setq str (vl-string->list  (vla-get-TextString x)))  
  81.            (setq str (vl-remove-if '(lambda(x) (or (= x 40)(= 41 x))) str))
  82.            (setq str (vl-list->string  str))
  83.            (vla-put-TextString x str)
  84.          )
  85.         ss
  86.   )
  87.   (princ)
  88. )
回复

使用道具 举报

 楼主| 发表于 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
这几个函数就行了

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
回复

使用道具 举报

 楼主| 发表于 2013-5-15 17:54:31 | 显示全部楼层
期待无聊大师,没事写写
回复

使用道具 举报

 楼主| 发表于 2013-8-18 17:20:46 | 显示全部楼层
pzweng 发表于 2013-5-14 09:24

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

使用道具 举报

发表于 2013-8-22 04:34:15 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
回复

使用道具 举报

 楼主| 发表于 2013-8-23 09:18:18 | 显示全部楼层
500w008 发表于 2013-8-22 04:34

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

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-12-14 05:11 , Processed in 0.217955 second(s), 22 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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