关于怎样框选单行文本批量生成序号的改进

YUYUFENG

之前在明经找到了框选单行文本批量修改序号的lisp，实际上作图时会有相同的单行文字，要求对应必须是相同的序号才行，拜托各位大佬帮帮忙修改一下。
原帖：求助对单行文字框选批量修改图号的功能 - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - Powered by Discuz! (mjtd.com)
以下是图片效果：

1. (vl-load-com)
   
2. (defun c:tt (/ )
   
3.   ;前缀设置
   
4.   (IF (null _0Text) (setq _0Text "前缀"))
   
5.   (setq 0Text (Getstring (Strcat "\n请输入前缀<" _0Text ">:")))
   
6.   (if (= 0Text "") (setq 0Text _0Text) (setq _0Text 0Text))
   
7.   (setq S (getint "\n请输入起始序号<1>:"))
   
8.   (If (Not S) (Setq S 1))
   
9.   ;选择需要的编号文字
   
10.   (prompt "请选择需要编号的文字")
    
11.   (setq ss (ssget  '((0 . "text"))) i1 -1 plst nil)
    
12.   (while (setq ent (ssname ss (setq i1 (1+ i1))))
    
13.          (setq plst (cons (list ent(cdr(assoc 10 (entget ent)))) plst)) )
    
14.   ;定义编号顺序
    
15.   (setq plst (vl-sort plst '(lambda (x y) (< (fix(/(car (cadr x))10)) (fix(/(car (cadr y))10))))))
    
16.   (setq plst (vl-sort plst '(lambda (x y) (> (fix(/(cadr (cadr x))10)) (fix(/(cadr (cadr y))10))))))
    
17.   ;List表
    
18.   (setq i1 -1)
    
19.   (repeat (length plst)
    
20.     (setq ent (car(nth (setq i1 (1+ i1)) plst)))
    
21.     (setq entdat (entget ent))
    
22.     (setq txt (strcat 0Text "-" (rtos(+ S i1))))
    
23.     ;文本插入坐标
    
24.     (setq p (cdr (assoc 11 entdat)) ;文本基点坐标
    
25.           px (car p)
    
26.           py (car (cdr p))
    
27.           x1 (+ px 10.0)
    
28.           y1 (+ py -7.0)
    
29.           p2 (list x1 y1)  
    
30.     )   
    
31.     ;建立单行文字
    
32.     (entmake (list '(0 . "TEXT")                     ;建立单行文字
    
33.                     (cons 1 txt)                     ;内容
    
34.                     (cons 41 0.75)                   ;宽度因子
    
35.                     (cons 72 1)                      ;水平对正样式
    
36.                     (cons 73 2)                      ;垂直对正样式
    
37.                     (cons 10 p2)                     ;坐标x
    
38.                     (cons 11 p2)                     ;坐标y
    
39.                     (cons 40 5.0)                     ;高度               
    
40.             )      
    
41.     )
    
42.     (entmake)  
    
43.   )
    
44. 
    
45.   (prompt (strcat "\n本次共修改：" (rtos (+ 1 i1) 2 1) "个,初始序号为:" (strcat 0Text "-" (rtos S))",结束序号为:" txt ))
    
46.   (princ)
    
47. )

(vl-load-com)<br /> (defun c:tt (/ )<br />   ;前缀设置<br />   (IF (null _0Text) (setq _0Text "前缀"))<br />   (setq 0Text (Getstring (Strcat "\n请输入前缀<" _0Text ">:")))<br />   (if (= 0Text "") (setq 0Text _0Text) (setq _0Text 0Text))<br />   (setq S (getint "\n请输入起始序号<1>:"))<br />   (If (Not S) (Setq S 1))<br />   ;选择需要的编号文字<br />   (prompt "请选择需要编号的文字")<br />   (setq ss (ssget  '((0 . "text"))) i1 -1 plst nil)<br />   (while (setq ent (ssname ss (setq i1 (1+ i1))))<br />          (setq plst (cons (list ent(cdr(assoc 10 (entget ent)))) plst)) )<br />   ;定义编号顺序<br />   (setq plst (vl-sort plst '(lambda (x y) (< (fix(/(car (cadr x))10)) (fix(/(car (cadr y))10))))))<br />   (setq plst (vl-sort plst '(lambda (x y) (> (fix(/(cadr (cadr x))10)) (fix(/(cadr (cadr y))10))))))<br />   ;List表<br />   (setq i1 -1)<br />   (repeat (length plst)<br />     (setq ent (car(nth (setq i1 (1+ i1)) plst)))<br />     (setq entdat (entget ent))<br />     (setq txt (strcat 0Text "-" (rtos(+ S i1))))<br />     ;文本插入坐标<br />     (setq p (cdr (assoc 11 entdat)) ;文本基点坐标<br />           px (car p)<br />           py (car (cdr p))<br />           x1 (+ px 10.0)<br />           y1 (+ py -7.0)<br />           p2 (list x1 y1)  <br />     )    <br />     ;建立单行文字<br />     (entmake (list '(0 . "TEXT")                     ;建立单行文字<br />                     (cons 1 txt)                     ;内容<br />                     (cons 41 0.75)                   ;宽度因子<br />                     (cons 72 1)                      ;水平对正样式<br />                     (cons 73 2)                      ;垂直对正样式<br />                     (cons 10 p2)                     ;坐标x<br />                     (cons 11 p2)                     ;坐标y<br />                     (cons 40 5.0)                     ;高度               <br />             )      <br />     )<br />     (entmake)  <br />   )<br /> <br />   (prompt (strcat "\n本次共修改：" (rtos (+ 1 i1) 2 1) "个,初始序号为:" (strcat 0Text "-" (rtos S))",结束序号为:" txt ))<br />   (princ)<br /> )

bai2000

字体插入位置有问题，改改

llsheng_73

把图名复制一份，把“图名”替换为“S-"

YUYUFENG

llsheng_73 发表于 2023-5-30 17:15
把图名复制一份，把“图名”替换为“S-"

图名只是例子而已哈

飞雪神光

1. (vl-load-com)
   
2. (defun c:tt (/ 0text ent entdat i1 lm-str2num p p2 plst px py s ss txt x1 y1)
   
3.         (defun lm-Str2num (String / positioni YPOutString)
   
4.                 (setq positioni -1 aiilst'() jci 0)
   
5.                 (repeat (strlen string)
   
6.                         (setq ascm(vl-string-elt string (setq positioni (+ positioni 1))))
   
7.                         (if(< 47 ascm 58)
   
8.                                 (setq aiilst(append aiilst (list ascm)))
   
9.                                 (setq jci (1+ jci))
   
10.                         )
    
11.                 )
    
12.                 (atoi(car(mapcar'VL-LIST->STRING(reverse (list aiilst)))))
    
13.         )
    
14.   (if (null _0text) (setq _0text "前缀"))
    
15.   (setq 0Text (Getstring (Strcat "\n请输入前缀<" _0Text ">:")))
    
16.   (if (= 0text "") (setq 0text _0text) (setq _0text 0text))
    
17.   ;选择需要的编号文字
    
18.   (prompt "请选择需要编号的文字")
    
19.   (setq ss (ssget  '((0 . "text"))) i1 -1 plst nil)
    
20.   (while (setq ent (ssname ss (setq i1 (1+ i1))))
    
21.                 (setq plst (cons (list ent(cdr(assoc 10 (entget ent)))) plst)) )
    
22.   ;定义编号顺序
    
23.   (setq plst (vl-sort plst '(lambda (x y) (< (fix(/(car (cadr x))10)) (fix(/(car (cadr y))10))))))
    
24.   (setq plst (vl-sort plst '(lambda (x y) (> (fix(/(cadr (cadr x))10)) (fix(/(cadr (cadr y))10))))))
    
25.   ;List表
    
26.   (setq i1 -1)
    
27.   (repeat (length plst)
    
28.     (setq ent (car (nth (setq i1 (1+ i1)) plst)))
    
29.     (setq entdat (entget ent))
    
30.     ;文本插入坐标
    
31.     (setq
    
32.                         p (cdr (assoc 11 entdat)) ;文本基点坐标
    
33.                         px (car p)
    
34.                         py (car (cdr p))
    
35.                         x1 (+ px 10.0)
    
36.                         y1 (+ py -7.0)
    
37.                         p2 (list x1 y1)
    
38.                   S(lm-Str2num        (cdr (assoc 1 entdat)))
    
39.     )  
    
40.     (setq txt (strcat 0Text "-" (rtos S)))               
    
41.     ;建立单行文字
    
42.     (entmake (list '(0 . "TEXT")                     ;建立单行文字
    
43.                                                          (cons 1 txt)                     ;内容
    
44.                                                          (cons 41 0.75)                   ;宽度因子
    
45.                                                          (cons 72 1)                      ;水平对正样式
    
46.                                                          (cons 73 2)                      ;垂直对正样式
    
47.                                                          (cons 10 p2)                     ;坐标x
    
48.                                                          (cons 11 p2)                     ;坐标y
    
49.                                                          (cons 40 5.0)                     ;高度               
    
50.                                                  )      
    
51.     )
    
52.     (entmake)  
    
53.   )
    
54.         (prompt (strcat "\n本次共修改：" (rtos (+ 1 i1) 2 1) "个序号"))
    
55.   (princ)
    
56. )

(vl-load-com)<br /> (defun c:tt (/ 0text ent entdat i1 lm-str2num p p2 plst px py s ss txt x1 y1)<br />         (defun lm-Str2num (String / positioni YPOutString)<br />                 (setq positioni -1 aiilst'() jci 0)<br />                 (repeat (strlen string)<br />                         (setq ascm(vl-string-elt string (setq positioni (+ positioni 1))))<br />                         (if(< 47 ascm 58)<br />                                 (setq aiilst(append aiilst (list ascm)))<br />                                 (setq jci (1+ jci))<br />                         )<br />                 )<br />                 (atoi(car(mapcar'VL-LIST->STRING(reverse (list aiilst)))))<br />         )<br />   (if (null _0text) (setq _0text "前缀"))<br />   (setq 0Text (Getstring (Strcat "\n请输入前缀<" _0Text ">:")))<br />   (if (= 0text "") (setq 0text _0text) (setq _0text 0text))<br />   ;选择需要的编号文字<br />   (prompt "请选择需要编号的文字")<br />   (setq ss (ssget  '((0 . "text"))) i1 -1 plst nil)<br />   (while (setq ent (ssname ss (setq i1 (1+ i1))))<br />                 (setq plst (cons (list ent(cdr(assoc 10 (entget ent)))) plst)) )<br />   ;定义编号顺序<br />   (setq plst (vl-sort plst '(lambda (x y) (< (fix(/(car (cadr x))10)) (fix(/(car (cadr y))10))))))<br />   (setq plst (vl-sort plst '(lambda (x y) (> (fix(/(cadr (cadr x))10)) (fix(/(cadr (cadr y))10))))))<br />   ;List表<br />   (setq i1 -1)<br />   (repeat (length plst)<br />     (setq ent (car (nth (setq i1 (1+ i1)) plst)))<br />     (setq entdat (entget ent))<br />     ;文本插入坐标<br />     (setq <br />                         p (cdr (assoc 11 entdat)) ;文本基点坐标<br />                         px (car p)<br />                         py (car (cdr p))<br />                         x1 (+ px 10.0)<br />                         y1 (+ py -7.0)<br />                         p2 (list x1 y1) <br />                   S(lm-Str2num        (cdr (assoc 1 entdat)))<br />     )  <br />     (setq txt (strcat 0Text "-" (rtos S)))                <br />     ;建立单行文字<br />     (entmake (list '(0 . "TEXT")                     ;建立单行文字<br />                                                          (cons 1 txt)                     ;内容<br />                                                          (cons 41 0.75)                   ;宽度因子<br />                                                          (cons 72 1)                      ;水平对正样式<br />                                                          (cons 73 2)                      ;垂直对正样式<br />                                                          (cons 10 p2)                     ;坐标x<br />                                                          (cons 11 p2)                     ;坐标y<br />                                                          (cons 40 5.0)                     ;高度               <br />                                                  )      <br />     )<br />     (entmake)  <br />   )<br />         (prompt (strcat "\n本次共修改：" (rtos (+ 1 i1) 2 1) "个序号"))<br />   (princ)<br /> )

czb203

飞雪神光 发表于 2023-5-30 22:25

哪里都有神光大侠的身影，感谢大佬~

YUYUFENG

飞雪神光 发表于 2023-5-30 22:25

大佬，你这是截取了尾部数值再拼接起来的而已，图名只是个例子啦。框选别的就不行了。会变成这样：file:///C:/Users/Administrator/Desktop/04.png

飞雪神光

YUYUFENG 发表于 2023-5-31 09:20
大佬，你这是截取了尾部数值再拼接起来的而已，图名只是个例子啦。框选别的就不行了。会变成这样：

有没有一种可能是你给的例子太少了 给的例子规则是一个 测试时拿出另一个规则来测试 等改完了又搞出个新规则说之前的不行

YUYUFENG

飞雪神光 发表于 2023-5-31 11:47
有没有一种可能是你给的例子太少了 给的例子规则是一个 测试时拿出另一个规则来测试 等改完了又搞出个新 ...

不好意思，一开始没表达清楚。