【K:RtnBox4SSGroup】矩形分堆/方框分堆

迷失1786 · 发表于 2024-5-26 21:37:35

谢谢楼主分享！

hubeiwdlue · 发表于 2024-6-5 18:39:08

谢谢苦茶大神分享。请教一个问题，如果我想获得的是分堆后的选择集列表，应该怎么使用比较合适呢？

kucha007 · 发表于 2024-6-5 19:53:56

hubeiwdlue 发表于 2024-6-5 18:39
谢谢苦茶大神分享。请教一个问题，如果我想获得的是分堆后的选择集列表，应该怎么使用比较合适呢？

ssget框选或者叉选啊(ssget “w” <pt1> <pt2> [filter-list])

hubeiwdlue · 发表于 2024-6-5 20:19:55

kucha007 发表于 2024-6-5 19:53
ssget框选或者叉选啊(ssget “w” [filter-list])

这样有可能选中坐标范围内，选择集范围外的图元。

kucha007 · 发表于 2024-6-5 20:38:06

hubeiwdlue 发表于 2024-6-5 20:19
这样有可能选中坐标范围内，选择集范围外的图元。

你一开始不就选择对象分堆了，怎么还会选择框之外的对象呢？

hubeiwdlue · 发表于 2024-6-5 20:52:06

kucha007 发表于 2024-6-5 20:38
你一开始不就选择对象分堆了，怎么还会选择框之外的对象呢？

一开始的选择集是过滤过的，每一个相交图元集合包围盒范围内可能有无关图元。分堆后，如果在通过ssget选择，会把无关图元选上。

kucha007 · 发表于 2024-6-5 21:00:45

hubeiwdlue 发表于 2024-6-5 20:52
一开始的选择集是过滤过的，每一个相交图元集合包围盒范围内可能有无关图元。分堆后，如果在通过ssget选 ...

那你就不能把过滤条件再加上咩？ssget也可以，或者遍历选择集去掉也可以。

hubeiwdlue · 发表于 2024-6-5 21:22:04

kucha007 发表于 2024-6-5 21:00
那你就不能把过滤条件再加上咩？ssget也可以，或者遍历选择集去掉也可以。

有道理，谢谢，谢谢。

hubeiwdlue · 发表于 2024-6-8 12:24:41

本帖最后由 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表的数据结构
)

;对图元进行扎堆分组(矩形分堆),并返回每一个组的包围盒 
;时间复杂度为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表的数据结构 
)

hubeiwdlue · 发表于 2024-6-8 12:30:26

另外，我觉得vl-sort排序函数，用cond编写条件是不是好一点，用if条理没有cond清晰。

账号		自动登录	找回密码
密码			注册