找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 2493|回复: 7

[已解决] 求给单行文字加上几份之几的尾缀的LISP代码

[复制链接]
发表于 2014-2-13 15:19:13 | 显示全部楼层 |阅读模式
悬赏100D豆已解决
求给单行文字加上几份之几的尾缀的LISP代码
要求在"SSGET"函数下框选过滤出含"------"的单行文字。如果A内容的单行文字只有一个,则不修改,否则如果有N个,则按X坐标从小到大排序后在单行文字内容后面加尾缀"(i/N)",I为从1到N的值。右边"结果"布局就是需要的结果。
请点击此处下载

查看状态:需购买或无权限

您的用户组是:游客

文件名称:求给单行文本加几分之几的代码.rar 
下载次数:3  文件大小:53 KB 
下载权限: 不限 以上  [免费赚D豆]





论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 1268个

财富等级: 财源广进

发表于 2014-2-13 15:19:14 | 显示全部楼层
  1. (defun c:tt (/ ss lst)
  2.   (if (setq ss (ssget '((1 . "##--------##'"))))
  3.     (progn
  4.       (setq lst        (mapcar
  5.                   '(lambda (x)
  6.                      (list
  7.                        (xdrx_getpropertyvalue x "TextString")
  8.                        (list (car (xdrx_getpropertyvalue x "Position")) x)
  9.                      )
  10.                    )
  11.                   (xdrx_pickset->ents ss)
  12.                 )
  13.             lst        (XD::List:GroupByIndex lst 0)
  14.             lst        (mapcar        '(lambda (x)
  15.                            (vl-sort x
  16.                                     '(lambda (a b)
  17.                                        (< (car a) (car b))
  18.                                      )
  19.                            )
  20.                          )
  21.                         (mapcar 'cdr lst)
  22.                 )
  23.             lst        (mapcar        '(lambda (x)
  24.                            (mapcar 'cadr x)
  25.                          )
  26.                         lst
  27.                 )
  28.       )
  29.       (mapcar '(lambda (x / l i)
  30.                  (setq l (length x))
  31.                  (if (> l 1)
  32.                    (progn
  33.                      (setq i 0)
  34.                      (mapcar '(lambda (a)
  35.                                 (xdrx_setpropertyvalue
  36.                                   a
  37.                                   "textstring"
  38.                                   (strcat (xdrx_getpropertyvalue
  39.                                             a
  40.                                             "textstring"
  41.                                           )
  42.                                           "("
  43.                                           (itoa (setq i (1+ i)))
  44.                                           "/"
  45.                                           (itoa l)
  46.                                           ")"
  47.                                   )
  48.                                 )
  49.                               )
  50.                              x
  51.                      )
  52.                    )
  53.                  )
  54.                )
  55.               lst
  56.       )
  57.     )
  58.   )
  59.   (princ)
  60. )

点评

111111105--------111111105 我要求的是,在“”字符前后可以有任意个字符,这才能适用于各种场合。朋友,帮我改一下吧  详情 回复 发表于 2014-2-13 17:46
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

 楼主| 发表于 2014-2-13 17:46:27 | 显示全部楼层

111111105--------111111105
我要求的是,在“”字符前后可以有任意个字符,这才能适用于各种场合。朋友,帮我改一下吧
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

已领礼包: 1268个

财富等级: 财源广进

发表于 2014-2-13 18:08:04 来自手机 | 显示全部楼层
清风明月10 发表于 2014-2-13 17:46
111111105--------111111105
我要求的是,在“”字符前后可以有任意个字符,这才能适用于各种场合。朋友 ...

修改过滤条件不会吗?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

 楼主| 发表于 2014-2-13 18:13:53 | 显示全部楼层
我改成了这样,可以避免2楼代码的缺陷。但又出现一个奇怪的问题,就是第一次输入“TT”命令,可以选中文字,第2次及以后,就不行了,这是为什么啊?
(defun c:tt (/ ss lst)
  ( ARXLOAD "CJ001089XDRX_API.R16.X32.arx");必须先加载“CJ001089XDRX_API.R16.X32.arx”,再加载“CJ001112晓东开源通用LISP函数库xd-lisp-lib.VLX”。如果按相反顺序加载,则不会成功
  ( LOAD "CJ001112晓东开源通用LISP函数库xd-lisp-lib.VLX")

  (if (setq ss (ssget '((0 . "TEXT")(1 . "*-------*"))))
    (progn
      (setq lst        (mapcar
                  '(lambda (x)
                     (list
                       (xdrx_getpropertyvalue x "TextString")
                       (list (car (xdrx_getpropertyvalue x "Position")) x)
                     )
                   )
                  (xdrx_pickset->ents ss)
                )
            lst        (XD::List:GroupByIndex lst 0)
            lst        (mapcar        '(lambda (x)
                           (vl-sort x
                                    '(lambda (a b)
                                       (< (car a) (car b))
                                     )
                           )
                         )
                        (mapcar 'cdr lst)
                )
            lst        (mapcar        '(lambda (x)
                           (mapcar 'cadr x)
                         )
                        lst
                )
      )
      (mapcar '(lambda (x / l i)
                 (setq l (length x))
                 (if (> l 1)
                   (progn
                     (setq i 0)
                     (mapcar '(lambda (a)
                                (xdrx_setpropertyvalue
                                  a
                                  "textstring"
                                  (strcat (xdrx_getpropertyvalue
                                            a
                                            "textstring"
                                          )
                                          "("
                                          (itoa (setq i (1+ i)))
                                          "/"
                                          (itoa l)
                                          ")"
                                  )
                                )
                              )
                             x
                     )
                   )
                 )
               )
              lst
      )
    )
  )
  (princ)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

已领礼包: 1268个

财富等级: 财源广进

发表于 2014-2-13 18:36:34 来自手机 | 显示全部楼层
你要排除已经编号的字,还要排除不需要编号的字
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

 楼主| 发表于 2014-2-13 19:11:49 | 显示全部楼层
本帖最后由 清风明月10 于 2014-2-13 19:27 编辑

不排除更好吧,排除就复杂化了。还有能否帮我写一个代码,删除括号及括号内的所有字符。就是2楼代码的逆过程 。我写了下面代码。但不行,它只能用于普通字符,无法利用星号(defun c:QQ()
(setvar "qaflags" 1)
(setq A 0)
  (if (setq ss (ssget  '((0 . "TEXT")(1 . "*--------*"))))
  (progn
  (QFMY-不匹配替换 SS "(*)" "")
  (setq A (SSLENGTH SS))))
(setvar "qaflags" 0)
(princ))
(defun QFMY-不匹配替换(单多行TEXT选择集 旧字符串 新字符串 /  ssl ct0 edata etext txtln subln ct1 ct2 schct newtext)
    (if 单多行TEXT选择集
    (progn
      (setq ssl (sslength 单多行TEXT选择集)
            ct0 0
            ct1 0
            ct2 0
            subln (strlen 旧字符串)
      )
      (while (< ct0 ssl)
        (setq edata (entget (ssname 单多行TEXT选择集 ct0))
              etext (cdr (assoc 1 edata))
              txtln (strlen etext)
              schct 1
              newtext ""
        )
        (while (<= schct txtln)
          (setq newtext
            (strcat newtext
              (if (= (setq readch (substr etext schct subln)) 旧字符串)
                (setq ct1 (1+ ct1)
                  schct (+ schct subln)
                  新字符串 新字符串
                )
                (progn
                  (setq schct (1+ schct))
                  (substr readch 1 1)
                )
              )
            )
          )
        )
        (if (/= etext newtext)
   (progn
            (entmod (subst (cons 1 newtext) (assoc 1 edata) edata))
            (setq ct2 (1+ ct2))
          )
        )
        (setq ct0 (1+ ct0))
      )
    )
  )
)


论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

已领礼包: 1268个

财富等级: 财源广进

发表于 2014-2-13 20:29:39 | 显示全部楼层
清风明月10 发表于 2014-2-13 19:11
不排除更好吧,排除就复杂化了。还有能否帮我写一个代码,删除括号及括号内的所有字符。就是2楼代码的逆过 ...

  1. (defun c:tt (/ ss )
  2.   (if (setq ss (ssget '((1 . "*------*(*)"))))
  3.     (mapcar '(lambda (x / str lst)
  4.                (setq str (xdrx_getpropertyvalue x "Textstring")
  5.                      lst (xdrx_string_split str "(")
  6.                )
  7.                (xdrx_setpropertyvalue x "Textstring" (car lst))
  8.              )
  9.             (xdrx_pickset->ents ss)
  10.     )
  11.   )
  12.   (princ)
  13. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

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

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-3-29 21:28 , Processed in 0.404442 second(s), 48 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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