设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 图元按大小排序
12下一页
返回列表 发新帖
查看: 1651|回复: 13

[讨论] 图元按大小排序

[复制链接]
aws
发表于 2023-5-2 20:14 | 显示全部楼层 |阅读模式
  • 大伙帮忙看看，我想写图元按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
  • )

回复

使用道具 举报

DLSPH
发表于 2023-12-19 14:27 | 显示全部楼层
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)
)
回复 支持 反对

使用道具 举报

liuhe
发表于 2023-5-2 21:07 | 显示全部楼层

  3. (defun c:js (/ BZ SS P YLST LST N EN ENBOX P1 P9 Y TUYUAN I YYLST EE P11)
  4.   (setvar "cmdecho" 0)
  5.   (command "undo" "be")
  6.   (setq bz(getvar "osmode"))(setvar "osmode" 0)
  7.   (setq ss(ssget))
  8.   (setq p(getpoint "\n选择排列起始点："))
  9.   (setq ylst '() lst '())
  10.   (repeat(setq n(sslength ss))
  11.     (setq en(ssname ss(setq n(1- n))))
  12.     (setq enbox(getenbox en))
  13.     (setq p1(car enbox))
  14.     (setq p9(cadr enbox))
  15.     (setq y(-(cadr p9)(cadr p1)));---获取单个图元的Y长度
  16.     (setq tuyuan(cdr(assoc -1(entget en))));---获取图元名
  17.     (setq lst(cons(list y tuyuan )lst))
  18.    
  19.   )
  20.   (setq        lst (vl-sort lst
  21.                      (function (lambda (e1 e2)
  22.                                  (<(car e1) (car e2))
  23.                                )
  24.                      )
  25.             )
  26.         I   0
  27.   )
  28.   (repeat (length LST)  
  29.     (setq yylst(nth I lst));---返回yy对应的那个
  30.     (setq EE(cadr yylst))
  31.     (setq enbox(getenbox EE))
  32.     (setq p11(car enbox))
  33.     (vla-move (vlax-ename->vla-object EE) (vlax-3D-point p11 ) (vlax-3D-point p ))
  34.     (setq enbox(getenbox EE))
  35.     (setq p(list(car(cadr enbox))(cadr P)))
  36.     (setq           I(1+ I))
  37.   )
  38.   (setvar "osmode" bz)
  39.   (command "undo" "e")
  40.   (setvar "cmdecho" 1)
  41.   (princ)
  42. )
  43. ;---返回a在表lst中的位置
  44. ;;;(defun lstwz(a lst / b)
  45. ;;;  (cond((setq b(member a lst))(-(length lst)(length b))))
  46. ;;;)
  47. ;---获取单个图元左下角，右上角，中心点坐标
  48. (defun getenbox(en / enbox py pz pzx)
  49.   (vla-getboundingbox(vlax-ename->vla-object en) 'minp 'maxp)
  50.   (setq pz(vlax-safearray->list minp))
  51.   (setq py(vlax-safearray->list maxp))
  52.   (setq pzx(mapcar '(lambda(X Y)(/(+ X Y)2))pz py))
  53.   (setq enbox(list pz py pzx))
  54.   enbox
  55. )


不知道是不是你想要的
回复 支持 反对

使用道具 举报

飞雪神光
发表于 2023-5-2 20:45 | 显示全部楼层
  1. (defun c:js(/ en enbox getenbox n p p1 p9 ss ty y ylst)
  2.         (defun getenbox(en / enbox py pz pzx)
  3.                 (vla-getboundingbox(vlax-ename->vla-object en) 'minp 'maxp)
  4.                 (setq pz(vlax-safearray->list minp))
  5.                 (setq py(vlax-safearray->list maxp))
  6.                 (setq pzx(mapcar '(lambda(X Y)(/(+ X Y)2))pz py))
  7.                 (setq enbox(list pz py pzx))
  8.                 enbox
  9.         )
  10.   (setvar "cmdecho" 0)
  11.   (command "undo" "be")
  12.   (setq ss(ssget))
  13.   (setq p(getpoint "\n选择排列起始点："))
  14.   (setq ylst '())
  15.   (repeat(setq n(sslength ss))
  16.     (setq en(ssname ss(setq n(1- n))))
  17.     (setq enbox(getenbox en))
  18.     (setq p1(car enbox))
  19.     (setq p9(cadr enbox))
  20.     (setq y(-(cadr p9)(cadr p1)));---获取单个图元的Y长度
  21.     (setq ylst(append ylst (list (list y en (list (car p1) (cadr p9))))))
  22.   )
  23.   (setq ylst (vl-sort ylst '(lambda (x y) (< (car x) (car y)))))
  24.         (foreach tylst ylst
  25.                 (setq y(car tylst))(print y)
  26.                 (setq ty(cadr tylst))
  27.                 (setq p1(caddr tylst))
  28.                 (command "move" ty "" "non" p1 "non" p)
  29.                 ;(setq p(polar p 0.0 y))
  30.                 (setq p(polar p (* pi 1.5) y))
  31.         )
  32.         (command "undo" "e")
  33.   (princ)
  34. )

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复 支持 反对

使用道具 举报

aws
 楼主| 发表于 2023-5-3 08:24 | 显示全部楼层
liuhe 发表于 2023-5-2 21:07
不知道是不是你想要的

非常完美，感谢指点
回复 支持 反对

使用道具 举报

aws
 楼主| 发表于 2023-5-3 08:25 | 显示全部楼层
飞雪神光 发表于 2023-5-2 20:45

感谢指点！
回复 支持 反对

使用道具 举报

h806600727
发表于 2023-5-3 16:54 | 显示全部楼层
如何让图元里的文字跟着一起移动，文字在图元中的位置不变，麻烦大佬给改一下
回复 支持 反对

使用道具 举报

aws
 楼主| 发表于 2023-5-3 19:26 | 显示全部楼层
h806600727 发表于 2023-5-3 16:54
如何让图元里的文字跟着一起移动，文字在图元中的位置不变，麻烦大佬给改一下

跟着一起移动，且相对位置不变，那么你就把文字和图元做成块，再移动呗，之后再把块炸开即可
回复 支持 反对

使用道具 举报

LYC688
发表于 2023-5-3 19:53 | 显示全部楼层
liuhe 发表于 2023-5-2 21:07
不知道是不是你想要的

应该可以指定选择X和y方向，这样好一些
回复 支持 反对

使用道具 举报

liuhe
发表于 2023-5-3 20:45 来自手机 | 显示全部楼层
LYC688 发表于 2023-5-3 19:53
应该可以指定选择X和y方向，这样好一些

……，要不你让程序更好一下？
回复 支持 反对

使用道具 举报

aws
 楼主| 发表于 2023-5-4 07:42 | 显示全部楼层
LYC688 发表于 2023-5-3 19:53
应该可以指定选择X和y方向，这样好一些

自己稍加修改就可以实现了，主要是学习大佬的一些关键节点方法
回复 支持 反对

使用道具 举报

12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-5-12 22:47 , Processed in 0.233862 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表