请教编号的递增递减控制
从论坛里拼凑修剪来的代码，批量生成多段线编号，怎么可以控制标记文字的递增顺序呀，比如说沿着X轴递增或递减，沿着Y轴递增或递减。
现在的代码好像有时候按顺序，有时候又不按数序，没有固定的规律，望老师们帮实现一下。
(defun C:NM (/ ss font_height1 n k po na)
(setq font_height 100)
(if (and (setq ss (ssget (list '(0 . "LWPOLYLINE")) )))
)
(progn
(setq n 0
k 1
)
(repeat (sslength ss)
(setq na (ssname ss n))
(setq po (Get_center_relative na))
(entmake (list '(0 . "TEXT")
(cons 1 (rtos k 2 0))
(cons 10 po)
(cons 40 font_height)
)
)
(setq k (1+ k))
(setq n (1+ n))
)
)
)
贴个图看看效果
本帖最后由 xj6019 于 2020-11-30 21:07 编辑
(DEFUN C:NM ()
(setq en(entlast))
(BHDXANSHUNX)
(setq ssn (fy_sslast en))
(sssetfirst nil SSN)
(chhangWZJDXJ)
(sssetfirst nil SSN)
(GWZTIANJQZHUITYY)
(sssetfirst nil SSN)
(WZJZZSFLJLA)
)
;;;;;改变文字角度代码
(DEFUN chhangWZJDXJ ()
(setq s (ssget))
(setq hig 90);;改变文字角度90
(if (= hig nil) (setq hig 0.0))
(setq hig (* pi hig) hig (/ hig 180.0))
(setq h50 (cons 50 hig))
(setq n (sslength s))
(setq k 0 )
(while (< k n)
(setq name (ssname s k))
(setq a (entget name))
(setq b (assoc '0 a))
(setq b (cdr b))
(if (= b "TEXT")(progn
(setq h (assoc '50 a))
(setq a (subst h50 h a))
(entmod a)
))
(setq k (+ k 1))
)
)
;;;;生成编号文字
(defun BHDXANSHUNX (/ ss font_height1 n k po na)
(setq font_height 100)
(if (and (setq ss (ssget (list '(0 . "LWPOLYLINE,region,circle"))))
)
(progn
(setq n 0
k 1
)
(repeat (sslength ss)
(setq na (ssname ss n))
(setq po (Get_center_relative na))
(entmake (list '(0 . "TEXT")
(cons 1 (rtos k 2 0))
(cons 10 po)
(cons 40 font_height)
)
)
(setq k (1+ k))
(setq n (1+ n))
)
)
)
(princ)
)
;;;;;;添加文字前后缀代码
(DEFUN GWZTIANJQZHUI()
(setq qh 1);;;1 前缀 2后缀
(setq s (ssget))
(setq str (getstring "\n输入前后缀文字:"))
(setq n (sslength s))
(setq k 0 )
(while (< k n)
(setq name (ssname s k))
(setq a (entget name))
(setq t1 (assoc '0 a))
(setq t1 (cdr t1))
(if (= t1 "TEXT") (PROGN
(setq h (assoc '1 a))
(setq hh (cdr h))
(if (= qh 1)(setqstr1 (strcat str hh)))
(if (/= qh 1)(setq str1 (strcat hh str)))
(setq h1 (cons 1 str1))
;(if (= str "") (setq h1 h))
(setq a (subst h1 h a))
(entmod a)
))
(setq k (+ k 1))
)
)
(defun Get_center_relative (ename / Pts 2R Mk
MklinepointsDelLine Tssredi
lst N NewlstDistList
R NumberTssbakTssSubPt
)
(setq Obj (Vlax-Ename->Vla-Object ename)
Tssbak (Vlax-Get Obj 'Thickness)
TssSub (Vlax-Put Obj 'Thickness 0)
)
(setq Pts (GetBoundingBox ename)
2R (MJ:MIDPOINT (CAR Pts) (CADR Pts))
Mk (entmake (list (cons 0 "LINE")
(cons 8 "JMDSS")
(cons 10 (polar 2R 0.0 1000))
(cons 11 (polar 2R 3.14159 1000))
)
)
Mkline (entlast)
points (vlax-invoke
(vlax-ename->vla-object ename)
'IntersectWith
(vlax-ename->vla-object Mkline)
acExtendOtherEntity
)
Tssred (Vlax-Put Obj 'Thickness (eval Tssbak))
DelLine (entdel Mkline)
i 0
lst nil
)
(repeat (/ (length points) 3)
(setq lst (append lst
(list (list (nth i points)
(nth (1+ i) points)
(nth (+ 2 i) points)
)
)
)
)
(setq i (+ i 3))
)
(setq lst (px lst))
(if (>= (length lst) 4)
(progn
(setq N 0
Newlst nil
)
(repeat (/ (length lst) 2)
(setq
Newlst (append Newlst
(list (list (nth N lst) (nth (1+ N) lst)))
)
)
(setq N (+ 2 N))
)
(setq DistList nil
R 0
)
(repeat (length Newlst)
(setq Number (nth R Newlst)
DistList (append DistList
(list (distance (car Number) (cadr Number)))
)
)
(setq R (1+ R))
)
(setq Pt (nth (vl-position (car (vl-sort DistList '>)) DistList)
Newlst
)
)
(MJ:MIDPOINT (car pt) (cadr pt)) ;返回?
)
(MJ:MIDPOINT (car lst) (cadr lst)) ;返回?
)
)
(defun MJ:MIDPOINT (P1 P2)
(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2)
)
(defun GetBoundingBox (ent / ll ur)
(vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
)
(defun px (X)
(vl-sort X
(function (lambda (e1 e2)
(< (car e1) (car e2))
)
)
)
)
;;程序来源于LLXXZZ大?
;;;http://bbs.mjtd.com/thread-89140-1-1.html
(defun GWZTIANJQZHUITYY (/SS SSLIST indexINDEX0 SSLIST-PTL
TMP-PTXZ_SORTLIST ENTLIST N
ED
)
;(C:CNM001xxx)
;(C:C88)
(setvar "CMDECHO" 0)
(setq ss (ssget '((0 . "TEXT"))))
(setq str (getstring "\n输入前后缀文字:"))
;_选择集=>图元列表
(setq sslist (ss2list ss) )
;_开始构建图元点位表
(setq index (sslength ss) );
(setq index0 0
sslist-ptl
'()
tmp-pt '()
)
(repeat index
(setq tmp-pt
(cons
(nth index0 sslist)
(cons (cdr (assoc 10 (entget (nth index0 sslist)))) tmp-pt)
)
)
(setq sslist-ptl (cons tmp-pt sslist-ptl))
(setq tmp-pt '())
(setq index0 (1+ index0))
)
;_从左到右从上到下
(setq XZ_sortlist
(vl-sort
(vl-sort sslist-ptl
'(lambda (s1 s2) (> (cadadr s1) (cadadr s2))) ;< 从右向左递增>从左向右递增对应改变大小号就能实现 递增方向的切换
)
'(lambda (s3 s4)
(if (equal (cadadr s3) (cadadr s4) 0.6)
(>(caadr s3) (caadr s4))
)
)
)
)
(setq entlistXX (mapcar '(lambda (x) (car x)) XZ_sortlist))
(setq entlist(HH:ssPts:SortentlistXX "X" 1))
;_更新文本数据
(setq n 1)
(mapcar '(lambda (x)
(setq ed (entget x))
(setq ed (subst (cons 1 (strcat str (VL-PRINC-TO-STRING n)));HJ-是编号的前缀也可以不加前缀就从1开始追个递增 左---右，上---下
(assoc 1 ed)
ed
)
)
(setq n (1+ n))
(entmod ed)
)
entlist
)
(princ)
(setq enX(entlast))
(princ)
)
;;选择集转为图元列表
(defun ss2list ( ss / n i elist )
(cond
((null ss) NIL)
((= (type ss) 'Pickset)
(setq n(sslength ss)
i n
elist '()
)
(repeat n
(setq i (1- i))
;;如果没有这个if，那么选择集中被删除的图元，也会被加入到列表之中????但是极其偶尔也有可能，图元不存在但是能entget（遇到过一次，原因不明，或许是CAD的BUG）
(if (entget (ssname ss i))
(setq elist (cons (ssname ss i) elist))
)
)
elist
)
((= (type ss) 'ename)
(list ss)
)
((= (type ss) 'list)
(vl-remove-if-not ''((x) (and (= (type x) 'ename) (entget x))) ss)
)
( T NIL )
)
)
(defun WZJZZSFLJLA(/ box en_tmp ent i pt0 pt1 ss tmp)
(setvar "CMDECHO" 0)
(vl-load-com)
(if (setq ss (ssget))
(progn
(defun box(e / ll ur)
(vla-getboundingbox (vlax-ename->vla-object e) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
)
(setq i -1)
(command "undo" "be")
(while (setq ent (ssname ss (setq i (1+ i))))
(setq tmp (box ent))
(setq tmp (mapcar '+ (car tmp) (cadr tmp)))
(setq pt0 (mapcar '* tmp '(0.5 0.5 0.5)))
(entdel ent)
(setq en_tmp (bpoly pt0))
(entdel ent)
(setq tmp (box en_tmp))
(setq tmp (mapcar '+ (car tmp) (cadr tmp)))
(setq pt1 (mapcar '* tmp '(0.5 0.5 0.5)))
(command "move" ent "" "non" pt0 "non" pt1)
(entdel en_tmp)
)
(command "undo" "e")
)
(princ "\n没有选择对象！")
)
(princ)
)以下是黄老师的函数
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=108678&highlight=%C5%C5%D0%F2
;;ssPts: 1 选择集，返回图元列表
;; 2 点表(1到n维 1维时key只能是x或X)，返回点表
;; 3 图元列表，返回图元列表
;;Key: "xyzXYZ"任意组合,例如"yX",y在前表示y坐标优先，小y表示从小到大(注:二维点时，不能有z)
;;FUZZ: 允许误差
;;注:点表可以1到n维混合,Key长度不大于点的最小维数。
;;示例1 (HH:ssPts:Sort (ssget) "YxZ" 0.5);返回(<Entity name: 7ef7b3a8> <Entity name: 7ef7b3a0>)
;;示例2 (HH:ssPts:Sort (list '(2 3) '(3 5)) "Yx" 0.5);返回((3 5) (2 3))
;;示例3 (HH:ssPts:Sort '(<Entity name: 7ef79a28> <Entity name: 7ef79a10>) "YxZ" 0.5)
;;示例4 (HH:ssPts:Sort (list "DF" "ZX" "A" "DD" "A") "X" 1)=>("ZX" "DF" "DD" "A" "A")
;;示例5 (HH:ssPts:Sort (list 5 8 5 9) "X" 1)=>(9 8 5)
;;本程序是在fsxm的扩展 自贡?明儒 2014年3月22日
(defun HH:ssPts:Sort (ssPts KEY FUZZ / E EN FUN LST N)
;;1 点列表排序
(defun sortpts (PTS FUN xyz FUZZ)
(vl-sort pts
'(lambda (a b)
(if (not (equal (xyz a) (xyz b) fuzz))
(fun (xyz a) (xyz b))
)
)
)
)
;;2 排序
(defun sortpts1 (PTS KEY FUZZ)
(setq Key (vl-string->list Key))
(foreach xyz (reverse Key)
(cond ((< xyz 100)
(setq fun >)
(setq xyz (nth (- xyz 88) (list car cadr caddr)))
)
(T
(setq fun <)
(setq xyz (nth (- xyz 120) (list car cadr caddr)))
)
)
(setq Pts (sortpts Pts fun xyz fuzz))
)
)
;;3 本程序主程序
(cond
((= (type ssPts) 'PICKSET)
(repeat (setq n (sslength ssPts))
(if (and (setq e (ssname ssPts (setq n (1- n))))
(setq en (entget e))
)
(setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
)
)
(mapcar 'last (sortpts1 lst KEY FUZZ))
)
((Listp ssPts)
(cond
((vl-consp (car ssPts)) (sortpts1 ssPts KEY FUZZ))
((= (type (car ssPts)) 'ENAME)
(foreach e ssPts
(if (setq en (entget e))
(setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
)
)
(mapcar 'last (sortpts1 lst KEY FUZZ))
)
(T
(cond ((equal key "X") (vl-sort ssPts '>))
(T (vl-sort ssPts '<))
)
)
)
)
)
)
不知道你们能运行起来了不，我这里目前电脑情绪还算稳定，说一下这一圈咋转的哦，框选多段线在各自的中心先生成一个数字，然后用代码给文字转动一个角度，上面是转了90度。因为生成的代码文字是左对齐，因此文字看着有些偏，然后给这些文字加个前缀后重新排序，搞了两天，最终还是用上了黄老师的代码后，才算正常，特此感谢，然后再把这组生成的文字进行中心对齐，嘿嘿嘿，无奈，暂时就只会这么拼一下用了，老师有好的方法可以实现的话，请不吝赐教呀。 可以先加入点表，并对其排序 给你们欣赏一下脑瓜子不够的人，为了实现一个功能，绕可能至少7852个圈后的成果;P:lol:'(:victory: 代码乱七八糟，丢人显眼啦，甚至在老师们眼里基本算的上是垃圾代码，没法，虽然乱，但是可以解决我目前遇到的批量编号的问题了，存上论坛，当个记事本备份一下自己的思路，仅此而已，也希望其他老师看到，能提供一个更好用的更简洁的代码。 绕圈的过程就是学习的过程 xj6019 发表于 2020-11-30 21:41
贴个图看看效果
请问您用的是什么软件编的
可以先加入点表，并对其排序
页:
[1]
2