关于怎样框选单行文本批量生成序号的改进
本帖最后由 YUYUFENG 于 2023-5-30 15:49 编辑之前在明经找到了框选单行文本批量修改序号的lisp，实际上作图时会有相同的单行文字，要求对应必须是相同的序号才行，拜托各位大佬帮帮忙修改一下。
原帖：求助对单行文字框选批量修改图号的功能 - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - Powered by Discuz! (mjtd.com)
以下是图片效果：
(vl-load-com)
(defun c:tt (/ )
;前缀设置
(IF (null _0Text) (setq _0Text "前缀"))
(setq 0Text (Getstring (Strcat "\n请输入前缀<" _0Text ">:")))
(if (= 0Text "") (setq 0Text _0Text) (setq _0Text 0Text))
(setq S (getint "\n请输入起始序号<1>:"))
(If (Not S) (Setq S 1))
;选择需要的编号文字
(prompt "请选择需要编号的文字")
(setq ss (ssget'((0 . "text"))) i1 -1 plst nil)
(while (setq ent (ssname ss (setq i1 (1+ i1))))
(setq plst (cons (list ent(cdr(assoc 10 (entget ent)))) plst)) )
;定义编号顺序
(setq plst (vl-sort plst '(lambda (x y) (< (fix(/(car (cadr x))10)) (fix(/(car (cadr y))10))))))
(setq plst (vl-sort plst '(lambda (x y) (> (fix(/(cadr (cadr x))10)) (fix(/(cadr (cadr y))10))))))
;List表
(setq i1 -1)
(repeat (length plst)
(setq ent (car(nth (setq i1 (1+ i1)) plst)))
(setq entdat (entget ent))
(setq txt (strcat 0Text "-" (rtos(+ S i1))))
;文本插入坐标
(setq p (cdr (assoc 11 entdat)) ;文本基点坐标
px (car p)
py (car (cdr p))
x1 (+ px 10.0)
y1 (+ py -7.0)
p2 (list x1 y1)
)
;建立单行文字
(entmake (list '(0 . "TEXT") ;建立单行文字
(cons 1 txt) ;内容
(cons 41 0.75) ;宽度因子
(cons 72 1) ;水平对正样式
(cons 73 2) ;垂直对正样式
(cons 10 p2) ;坐标x
(cons 11 p2) ;坐标y
(cons 40 5.0) ;高度
)
)
(entmake)
)
(prompt (strcat "\n本次共修改：" (rtos (+ 1 i1) 2 1) "个,初始序号为:" (strcat 0Text "-" (rtos S))",结束序号为:" txt ))
(princ)
)
字体插入位置有问题，改改 把图名复制一份，把“图名”替换为“S-" llsheng_73 发表于 2023-5-30 17:15
把图名复制一份，把“图名”替换为“S-"
图名只是例子而已哈 (vl-load-com)
(defun c:tt (/ 0text ent entdat i1 lm-str2num p p2 plst px py s ss txt x1 y1)
(defun lm-Str2num (String / positioni YPOutString)
(setq positioni -1 aiilst'() jci 0)
(repeat (strlen string)
(setq ascm(vl-string-elt string (setq positioni (+ positioni 1))))
(if(< 47 ascm 58)
(setq aiilst(append aiilst (list ascm)))
(setq jci (1+ jci))
)
)
(atoi(car(mapcar'VL-LIST->STRING(reverse (list aiilst)))))
)
(if (null _0text) (setq _0text "前缀"))
(setq 0Text (Getstring (Strcat "\n请输入前缀<" _0Text ">:")))
(if (= 0text "") (setq 0text _0text) (setq _0text 0text))
;选择需要的编号文字
(prompt "请选择需要编号的文字")
(setq ss (ssget'((0 . "text"))) i1 -1 plst nil)
(while (setq ent (ssname ss (setq i1 (1+ i1))))
(setq plst (cons (list ent(cdr(assoc 10 (entget ent)))) plst)) )
;定义编号顺序
(setq plst (vl-sort plst '(lambda (x y) (< (fix(/(car (cadr x))10)) (fix(/(car (cadr y))10))))))
(setq plst (vl-sort plst '(lambda (x y) (> (fix(/(cadr (cadr x))10)) (fix(/(cadr (cadr y))10))))))
;List表
(setq i1 -1)
(repeat (length plst)
(setq ent (car (nth (setq i1 (1+ i1)) plst)))
(setq entdat (entget ent))
;文本插入坐标
(setq
p (cdr (assoc 11 entdat)) ;文本基点坐标
px (car p)
py (car (cdr p))
x1 (+ px 10.0)
y1 (+ py -7.0)
p2 (list x1 y1)
S(lm-Str2num (cdr (assoc 1 entdat)))
)
(setq txt (strcat 0Text "-" (rtos S)))
;建立单行文字
(entmake (list '(0 . "TEXT") ;建立单行文字
(cons 1 txt) ;内容
(cons 41 0.75) ;宽度因子
(cons 72 1) ;水平对正样式
(cons 73 2) ;垂直对正样式
(cons 10 p2) ;坐标x
(cons 11 p2) ;坐标y
(cons 40 5.0) ;高度
)
)
(entmake)
)
(prompt (strcat "\n本次共修改：" (rtos (+ 1 i1) 2 1) "个序号"))
(princ)
) 飞雪神光 发表于 2023-5-30 22:25
哪里都有神光大侠的身影，感谢大佬~ 飞雪神光 发表于 2023-5-30 22:25
大佬，你这是截取了尾部数值再拼接起来的而已，图名只是个例子啦。框选别的就不行了。会变成这样：file:///C:/Users/Administrator/Desktop/04.png 本帖最后由 飞雪神光 于 2023-5-31 11:49 编辑
YUYUFENG 发表于 2023-5-31 09:20
大佬，你这是截取了尾部数值再拼接起来的而已，图名只是个例子啦。框选别的就不行了。会变成这样：
有没有一种可能是你给的例子太少了 给的例子规则是一个 测试时拿出另一个规则来测试 等改完了又搞出个新规则说之前的不行 飞雪神光 发表于 2023-5-31 11:47
有没有一种可能是你给的例子太少了 给的例子规则是一个 测试时拿出另一个规则来测试 等改完了又搞出个新 ...
不好意思，一开始没表达清楚。
页:
[1]