图元按大小排序
[*]大伙帮忙看看，我想写图元按Y轴长度来从左到右排序，
[*]这段代码，哪里出了问题，另外这个思路能不能行得通？
[*]
[*](defun c:js()
[*](setvar "cmdecho" 0)
[*](command "undo" "be")
[*](setq bz(getvar "osmode"))(setvar "osmode" 0)
[*](setq ss(ssget))
[*](setq p(getpoint "\n选择排列起始点："))
[*](setq ylst '() lst '())
[*](repeat(setq n(sslength ss))
[*] (setq en(ssname ss(setq n(1- n))))
[*] (setq enbox(getenbox en))
[*] (setq p1(car enbox))
[*] (setq p9(cadr enbox))
[*] (setq y(-(cadr p9)(cadr p1)));---获取单个图元的Y长度
[*] (setq tuyuan(cdr(assoc -1(entget en))));---获取图元名
[*] (setq ylst(cons y ylst))
[*] (setq lst(cons(list y tuyuan p1 p9)lst))
[*])
[*](repeat (sslength ss)
[*] (setq yy(apply 'max ylst));---返回最大y长度
[*] (setq yylst(nth(lstwz yy ylst)lst));---返回yy对应的那个
[*] (setq ylst(vl-remove yy ylst));---删掉列表中指定元素
[*] (setq sss(ssadd))
[*] (setq yyen(cadr yylst))
[*] (setq p11(caddr yylst))
[*] (setq p99(cadddr yylst))
[*] (setq p33(list(car p99)(cadr p11)))
[*] (ssadd yyen sss)
[*] (command "MOVE" sss "" p11 p)
[*] (setq p p33)
[*])
[*](setvar "osmode" bz)
[*](command "undo" "e")
[*](setvar "cmdecho" 1)
[*](princ)
[*])
[*];---返回a在表lst中的位置
[*](defun lstwz(a lst / b)
[*](cond((setq b(member a lst))(-(length lst)(length b))))
[*])
[*];---获取单个图元左下角，右上角，中心点坐标
[*](defun getenbox(en / enbox py pz pzx)
[*](vla-getboundingbox(vlax-ename->vla-object en) 'minp 'maxp)
[*](setq pz(vlax-safearray->list minp))
[*](setq py(vlax-safearray->list maxp))
[*](setq pzx(mapcar '(lambda(X Y)(/(+ X Y)2))pz py))
[*](setq enbox(list pz py pzx))
[*]enbox
[*])
(defun c:js (/ BZ SS P YLST LST N EN ENBOX P1 P9 Y TUYUAN I YYLST EE P11)
(setvar "cmdecho" 0)
(command "undo" "be")
(setq bz(getvar "osmode"))(setvar "osmode" 0)
(setq ss(ssget))
(setq p(getpoint "\n选择排列起始点："))
(setq ylst '() lst '())
(repeat(setq n(sslength ss))
(setq en(ssname ss(setq n(1- n))))
(setq enbox(getenbox en))
(setq p1(car enbox))
(setq p9(cadr enbox))
(setq y(-(cadr p9)(cadr p1)));---获取单个图元的Y长度
(setq tuyuan(cdr(assoc -1(entget en))));---获取图元名
(setq lst(cons(list y tuyuan )lst))
)
(setq lst (vl-sort lst
(function (lambda (e1 e2)
(<(car e1) (car e2))
)
)
)
I 0
)
(repeat (length LST)
(setq yylst(nth I lst));---返回yy对应的那个
(setq EE(cadr yylst))
(setq enbox(getenbox EE))
(setq p11(car enbox))
(vla-move (vlax-ename->vla-object EE) (vlax-3D-point p11 ) (vlax-3D-point p ))
(setq enbox(getenbox EE))
(setq p(list(car(cadr enbox))(cadr P)))
(setq I(1+ I))
)
(setvar "osmode" bz)
(command "undo" "e")
(setvar "cmdecho" 1)
(princ)
)
;---返回a在表lst中的位置
;;;(defun lstwz(a lst / b)
;;;(cond((setq b(member a lst))(-(length lst)(length b))))
;;;)
;---获取单个图元左下角，右上角，中心点坐标
(defun getenbox(en / enbox py pz pzx)
(vla-getboundingbox(vlax-ename->vla-object en) 'minp 'maxp)
(setq pz(vlax-safearray->list minp))
(setq py(vlax-safearray->list maxp))
(setq pzx(mapcar '(lambda(X Y)(/(+ X Y)2))pz py))
(setq enbox(list pz py pzx))
enbox
)
不知道是不是你想要的 ninja37 发表于 2023-5-18 22:19
大师能不能改一下加上一个选项 按等距离排列的功能
(defun c:JS(/ en enbox getenbox n p p1 p9 ss ty y ylst)
(defun getenbox(en / enbox py pz pzx)
(vla-getboundingbox(vlax-ename->vla-object en) 'minp 'maxp)
(setq pz(vlax-safearray->list minp))
(setq py(vlax-safearray->list maxp))
(setq pzx(mapcar '(lambda(X Y)(/(+ X Y)2))pz py))
(setq enbox(list pz py pzx))
enbox
)
(setvar "cmdecho" 0)
(command "undo" "be")
(setq os1 (getvar "osmode"))
(setvar "osmode" 1)
(if (= selcc nil) (setq selcc 10)) ;偏移距离初设 0
(setq cc1 (getdist (strcat "输入间距:<" (rtos selcc) ">")))
(if (= cc1 nil)(setq cc1 selcc )(setq selcc cc1))
(setvar "osmode" 0)
(setq ss(ssget))
(setq p(getpoint "\n选择排列起始点："))
(setq ylst '())
(repeat(setq n(sslength ss))
(setq en(ssname ss(setq n(1- n))))
(setq enbox(getenbox en))
(if (= N nil)
(exit)
)
(setq p1(car enbox))
(setq p9(cadr enbox))
(setq y(-(cadr p9)(cadr p1)));---获取单个图元的Y长度
(setq ylst(append ylst (list (list y en (list (car p1) (cadr p9))))))
)
(setq ylst (vl-sort ylst '(lambda (x y) (< (car x) (car y)))))
(foreach tylst ylst
(setq y(car tylst))(print y)
(setq ty(cadr tylst))
(setq p1(caddr tylst))
(command "move" ty "" "non" p1 "non" p)
;(setq p(polar p 0.0 y))
(setq p(polar p (* pi 1.5) (+ y cc1)))
)
(setvar "osmode" os1)
(command "UNDO" "e")
(setvar "cmdecho" 1)
(princ)
) (defun c:js(/ en enbox getenbox n p p1 p9 ss ty y ylst)
(defun getenbox(en / enbox py pz pzx)
(vla-getboundingbox(vlax-ename->vla-object en) 'minp 'maxp)
(setq pz(vlax-safearray->list minp))
(setq py(vlax-safearray->list maxp))
(setq pzx(mapcar '(lambda(X Y)(/(+ X Y)2))pz py))
(setq enbox(list pz py pzx))
enbox
)
(setvar "cmdecho" 0)
(command "undo" "be")
(setq ss(ssget))
(setq p(getpoint "\n选择排列起始点："))
(setq ylst '())
(repeat(setq n(sslength ss))
(setq en(ssname ss(setq n(1- n))))
(setq enbox(getenbox en))
(setq p1(car enbox))
(setq p9(cadr enbox))
(setq y(-(cadr p9)(cadr p1)));---获取单个图元的Y长度
(setq ylst(append ylst (list (list y en (list (car p1) (cadr p9))))))
)
(setq ylst (vl-sort ylst '(lambda (x y) (< (car x) (car y)))))
(foreach tylst ylst
(setq y(car tylst))(print y)
(setq ty(cadr tylst))
(setq p1(caddr tylst))
(command "move" ty "" "non" p1 "non" p)
;(setq p(polar p 0.0 y))
(setq p(polar p (* pi 1.5) y))
)
(command "undo" "e")
(princ)
) liuhe 发表于 2023-5-2 21:07
不知道是不是你想要的
非常完美，感谢指点 飞雪神光 发表于 2023-5-2 20:45
感谢指点！ 如何让图元里的文字跟着一起移动，文字在图元中的位置不变:handshake，麻烦大佬给改一下 h806600727 发表于 2023-5-3 16:54
如何让图元里的文字跟着一起移动，文字在图元中的位置不变，麻烦大佬给改一下
跟着一起移动，且相对位置不变，那么你就把文字和图元做成块，再移动呗，之后再把块炸开即可 liuhe 发表于 2023-5-2 21:07
不知道是不是你想要的
应该可以指定选择X和y方向，这样好一些 LYC688 发表于 2023-5-3 19:53
应该可以指定选择X和y方向，这样好一些
……，要不你让程序更好一下？ LYC688 发表于 2023-5-3 19:53
应该可以指定选择X和y方向，这样好一些
自己稍加修改就可以实现了，主要是学习大佬的一些关键节点方法
页:
[1]
2