求给单行文字加上几份之几的尾缀的LISP代码

清风明月10 · 发表于 2014-2-13 15:19:13

求给单行文字加上几份之几的尾缀的LISP代码
要求在"SSGET"函数下框选过滤出含"------"的单行文字。如果A内容的单行文字只有一个，则不修改，否则如果有N个，则按X坐标从小到大排序后在单行文字内容后面加尾缀"（i/N）"，I为从1到N的值。右边"结果"布局就是需要的结果。

请点击此处下载

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

您的用户组是：游客

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

st788796 · 发表于 2014-2-13 15:19:14

(defun c:tt (/ ss lst)
(if (setq ss (ssget '((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)
)

(defun c:tt (/ ss lst) 
  (if (setq ss (ssget '((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) 
)

清风明月10 · 发表于 2014-2-13 17:46:27

st788796 发表于 2014-2-13 17:15

111111105--------111111105
我要求的是，在“”字符前后可以有任意个字符，这才能适用于各种场合。朋友，帮我改一下吧

st788796 · 发表于 2014-2-13 18:08:04

清风明月10 发表于 2014-2-13 17:46
111111105--------111111105
我要求的是，在“”字符前后可以有任意个字符，这才能适用于各种场合。朋友 ...

修改过滤条件不会吗？

清风明月10 · 发表于 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)
)

st788796 · 发表于 2014-2-13 18:36:34

你要排除已经编号的字，还要排除不需要编号的字

清风明月10 · 发表于 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))
 )
)
 )
)

st788796 · 发表于 2014-2-13 20:29:39

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

(defun c:tt (/ ss )
(if (setq ss (ssget '((1 . "*------*(*)"))))
(mapcar '(lambda (x / str lst)
(setq str (xdrx_getpropertyvalue x "Textstring")
lst (xdrx_string_split str "(")
)
(xdrx_setpropertyvalue x "Textstring" (car lst))
)
(xdrx_pickset->ents ss)
)
)
(princ)
)

账号		自动登录	找回密码
密码			立即注册

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

最佳答案

点评