谢谢楼主分享！:lol:lol
谢谢苦茶大神分享。请教一个问题，如果我想获得的是分堆后的选择集列表，应该怎么使用比较合适呢？
hubeiwdlue 发表于 2024-6-5 18:39
谢谢苦茶大神分享。请教一个问题，如果我想获得的是分堆后的选择集列表，应该怎么使用比较合适呢？
ssget框选或者叉选啊(ssget “w” <pt1> <pt2> )
kucha007 发表于 2024-6-5 19:53
ssget框选或者叉选啊(ssget “w” )
这样有可能选中坐标范围内，选择集范围外的图元。
hubeiwdlue 发表于 2024-6-5 20:19
这样有可能选中坐标范围内，选择集范围外的图元。
你一开始不就选择对象分堆了，怎么还会选择框之外的对象呢？
kucha007 发表于 2024-6-5 20:38
你一开始不就选择对象分堆了，怎么还会选择框之外的对象呢？
一开始的选择集是过滤过的，每一个相交图元集合包围盒范围内可能有无关图元。分堆后，如果在通过ssget选择，会把无关图元选上。
hubeiwdlue 发表于 2024-6-5 20:52
一开始的选择集是过滤过的，每一个相交图元集合包围盒范围内可能有无关图元。分堆后，如果在通过ssget选 ...
那你就不能把过滤条件再加上咩？ssget也可以，或者遍历选择集去掉也可以。
kucha007 发表于 2024-6-5 21:00
那你就不能把过滤条件再加上咩？ssget也可以，或者遍历选择集去掉也可以。
有道理，谢谢，谢谢。
本帖最后由 hubeiwdlue 于 2024-6-16 11:47 编辑
苦茶大师，有一小段代码感觉很复杂，读不太明白，做了简化，不知道对不对，试了几个图形，感觉也能分对。您帮忙看一下。;对图元进行扎堆分组(矩形分堆),并返回每一个组的包围盒
;时间复杂度为n(1)，测试了17万个图元480组仅10秒
;作者：Tryhi-大海 (优化 by Kucha)
;SS是选择集，Dist是方框之间的间隙容差。
(defun K:RtnBox4SSGroup (SS Dist / K:GetEntBox K:GetSSBoxLst K:2RecIntersect Lst NewLst TmpLst Flag Rdo BasRec FstRec IntRec a b)
(progn ;基础函数
;获取实体最小外接矩形的WCS坐标(忽略Z值)
(defun K:GetEntBox (en / MaxPt MinPt)
(vla-GetBoundingBox (vlax-ename->vla-object en) 'MinPt 'MaxPt) ;取得包容图元的最大点和最小点
(setq MinPt (vlax-safearray->list MinPt)) ;把变体数据转化为表
(setq MaxPt (vlax-safearray->list MaxPt)) ;把变体数据转化为表
(list (car MinPt) (cadr MinPt) (car MaxPt) (cadr MaxPt))
)
;获取选择集每个实体的最小边界框坐标列表
(defun K:GetSSBoxLst (SS / i en Lst)
(if SS
(repeat (setq i (sslength SS))
(setq en (ssname SS (setq i (1- i))))
(setq Lst (cons (K:GetEntBox en) Lst))
)
)
Lst
)
;如果矩形相交，则返回两矩形的最大边界框，否则，返回nil
(defun K:2RecIntersect (A B)
(if
(not
(or;不可能重叠的四种情况
(> (car A) (caddr B)) ;A的左侧比B的右侧大：X
(> (cadr A) (Last B)) ;A的下部比B的上部大：Y
(< (caddr A) (car B)) ;A的右侧比B的左侧小：X
(< (Last A) (cadr B)) ;A的上部比B的下部小：Y
)
)
(list
(min (car A) (car B))
(min (cadr A) (cadr B))
(max (caddr A) (caddr B))
(max (Last A) (Last B))
)
)
)
)
(if (and SS(setq Dist (/ Dist 2)))
(progn
(setq Lst
(vl-sort
(K:GetSSBoxLst SS);嵌套表，每个图元坐标一个子表，(左(minX) 下(miny) 右(maxx) 上(maxy))
'(lambda (A B) ;左下右上
(if (equal (car A) (car B) 1e-3)
(if (equal (cadr A) (cadr B) 1e-3)
(if (equal (caddr A) (caddr B) 1e-3)
(< (cadddr A) (cadddr B)) ;上小在前
(< (caddr A) (caddr B)) ;右小在前
)
(< (cadr A) (cadr B)) ;下小在前
)
(< (car A) (car B)) ;左小在前
)
)
)
);边界框矩形排序,左小->下小->右小->上小，即从左往右，从下往上排序
(setq Lst
(mapcar
'(lambda (x)
(list
(- (car x) Dist)
(- (cadr x) Dist)
(+ (caddr x) Dist)
(+ (cadddr x) Dist)
)
)
Lst
)
);矩形扩大
(setq Flag T
NewLst Nil
)
(while Flag
(setq BasRec (car Lst);第一个元素
TmpLst Nil
)
(repeat (1-(length Lst))
(setq lst (cdr lst))
(if (setq IntRec (K:2RecIntersect BasRec (setq FstRec (car Lst)))) ;如果相交,新表
(setq BasRec IntRec);更新表
(setq TmpLst (cons FstRec TmpLst))
)
)
(setq NewLst (cons BasRec NewLst)
lst (reverse TmpLst)
)
(if (null TmpLst)
(setq Flag Nil)
)
)
(setq Lst
(mapcar
'(lambda (x)
(list
(+ (car x) Dist)
(+ (cadr x) Dist)
(- (caddr x) Dist)
(- (cadddr x) Dist)
)
)
NewLst
)
);矩形缩小
)
);矩形分堆得到互不相交的矩形LST
(setq Lst
(mapcar
'(lambda (x)
(list
(list (car x) (cadr x))
(list (caddr x) (cadddr x))
)
)
Lst
)
);调整LST表的数据结构
)
另外，我觉得vl-sort排序函数，用cond编写条件是不是好一点，用if条理没有cond清晰。