【BoxGroup】获取实体或对象的WCS/UCS最小边界框
本帖最后由 kucha007 于 2024-3-23 18:08 编辑;返回实体或对象最小边界框的WCS坐标(左下角和右上角)@Gu_xl
(defun K:GetWCSBox (obj / p1 p2 p3 p4 WCSBox)
(if (eq 'ENAME (type obj))(setq obj (vlax-ename->vla-object obj)))
(vla-GetBoundingBox obj 'p1 'p3)
(setq p1 (vlax-safearray->list p1)
p3 (vlax-safearray->list p3)
p2 (list (car p1) (cadr p3) (caddr p1))
p4 (list (car p3) (cadr p1) (caddr p1))
)
(if (eq "AcDbSpline" (Vla-Get-ObjectName obj));样条曲线取投影
(progn
(setq WCSBox (mapcar
'(lambda (a b) (vlax-curve-getClosestPointToProjection obj a b t))
(list p1 p2 p3 p4)
'((1.0 0 0) (0 -1.0 0) (-1.0 0 0) (0 1.0 0))
)
)
(list
(apply 'mapcar (cons 'min WCSBox));表中最小
(apply 'mapcar (cons 'max WCSBox));表中最大
)
)
(list p1 p3)
)
)
;返回实体或对象最小边界框的UCS坐标(左下角和右上角)@Kucha
(defun K:GetUCSBox (obj / K:CvtMatrix UCSBox)
(if (eq 'ENAME (type obj))(setq obj (vlax-ename->vla-object obj)))
;矩阵转换/坐标系转换
(defun K:CvtMatrix (from to)
(append
(mapcar
(function
(lambda (v o)
(append (trans v from to t) (list o))
)
)
'((1.0 0.0 0.0)
(0.0 1.0 0.0)
(0.0 0.0 1.0)
)
(trans '(0.0 0.0 0.0) to from)
)
'((0.0 0.0 0.0 1.0))
)
)
(vla-transformby obj (vlax-tmatrix (K:CvtMatrix 1 0)));对象转换到WCS
(setq UCSBox (K:GetWCSBox obj));获取转换后的最小矩形框(WCS)
(vla-transformby obj (vlax-tmatrix (K:CvtMatrix 0 1)));对象转换回UCS
UCSBox
)
;获取选择集所有实体的最小边界框表(WCS/UCS)@Kucha
(defun K:SSAllBoxLst (WCS TgtSS / i en SSBox)
(if TgtSS
(repeat (setq i (sslength TgtSS))
(setq en (ssname TgtSS (setq i (1- i))))
(setq SSBox
(cons
(if WCS (K:GetWCSBox en) (K:GetUCSBox en))
SSBox
)
)
)
)
SSBox
)
;获取选择集的最小边界框(WCS/UCS)@Kucha
(defun K:SSMinBoxLst (WCS TgtSS / i en Box BoxMin BoxMax MinPt MaxPt)
(if TgtSS
(repeat (setq i (sslength TgtSS))
(setq en (ssname TgtSS (setq i (1- i))))
(setq Box (if WCS (K:GetWCSBox en) (K:GetUCSBox en)))
(setq BoxMin (car Box) BoxMax (cadr Box))
(setq MinPt (mapcar 'min BoxMin (cond (MinPt) (BoxMin))))
(setq MaxPt (mapcar 'max BoxMax (cond (MaxPt) (BoxMax))))
)
)
(list MinPt MaxPt)
)
;获取选择集最小边界框表的最小值,即左下角(WCS/UCS)@Kucha
(defun K:SSBoxMinPT (WCS TgtSS / i en BoxMin MinPt)
(if TgtSS
(repeat (setq i (sslength TgtSS))
(setq en (ssname TgtSS (setq i (1- i))))
(setq BoxMin (car (if WCS (K:GetWCSBox en) (K:GetUCSBox en))))
(setq MinPt (mapcar 'min BoxMin (cond (MinPt) (BoxMin))))
)
)
MinPt
)
本帖最后由 kucha007 于 2024-3-4 13:24 编辑
应用实例：(K:RtnBox4Group 边界框顶点表 允许合并的间隙 行距)
;矩形分组(矩形分堆),并返回每一个组的包围盒@Tryhi-大海(优化 by Kucha)
(defun K:RtnBox4Group (RecLst Gap SpcTol / K:2RecInters NewLst TmpLst Flag RdoLst BasRec FstRec IntRec a b)
;时间复杂度为n(1)，测试了17万个图元480组仅10秒
;如果矩形相交，则返回两矩形的最大边界框
(defun K:2RecInters (Fst Sec)
(if
(not
(or;不可能重叠的四种情况
(> (car Fst) (caddr Sec)) ;A的左侧比B的右侧大：X
(> (cadr Fst) (Last Sec)) ;A的下部比B的上部大：Y
(< (caddr Fst) (car Sec)) ;A的右侧比B的左侧小：X
(< (Last Fst) (cadr Sec)) ;A的上部比B的下部小：Y
)
)
(list
(min (car Fst) (car Sec))
(min (cadr Fst) (cadr Sec))
(max (caddr Fst) (caddr Sec))
(max (Last Fst) (Last Sec))
)
)
)
(if (and RecLst(setq Gap (/ Gap 2)))
(progn
(setq RecLst
(mapcar
'(lambda (XX)
(list
(nth 0 (car XX)) (nth 1 (car XX))
(nth 0 (cadr XX)) (nth 1 (cadr XX))
)
)
RecLst
)
);只取XY合并组成新的表,排序时再调整回来
(setq RecLst (mapcar '(lambda (XX) (mapcar '+ XX (list (- Gap) (- Gap) Gap Gap))) RecLst));矩形扩大
(progn ;合并矩形
(setq Flag T RdoLst Nil)
(while Flag
(setq BasRec (car RecLst) NewLst Nil)
(while (setq FstRec (car RecLst)) ;主要耗时点
(setq RecLst (cdr RecLst)) ;更新列表
(if (setq IntRec (K:2RecInters BasRec (setq FstRec (car RecLst))))
(setq BasRec IntRec);RecLst中有和BasRec相交的矩形,更新BasRec
(if
(setq TmpLst (vl-some
'(lambda (a / b)
(if (setq b (K:2RecInters BasRec a))
(list b a)
)
)
NewLst
)
);NewLst中有和BasRec相交的矩形
(progn
(if (not (eq (car TmpLst) (Last TmpLst)))
(setq NewLst (subst (car TmpLst) (Last TmpLst) NewLst))
);相交矩形和表中对应元素不同则替换
(setq BasRec FstRec)
)
(setq NewLst (cons BasRec NewLst)
BasRec FstRec
);收集并更新
)
)
)
(if (eq (length NewLst) (length RdoLst))
(setq Flag Nil)
(setq RdoLst NewLst
RecLst NewLst
)
)
)
)
(setq NewLst (mapcar '(lambda (XX) (mapcar '+ XX (list Gap Gap (- Gap) (- Gap)))) NewLst));矩形缩小
(vl-sort
(mapcar
'(lambda (x)
(list
(list (car x) (cadr x))
(list (caddr x) (cadddr x))
)
)
NewLst
);重新调整LST表的数据结构
'(lambda (a b)
(if (equal (cadr (car a)) (cadr (car b)) SpcTol);Y在容差内相等？
(if (equal (car (car a)) (car (car b)));X相等
(> (cadr (car a)) (cadr (car b))) ;比较Y
(< (car (car a)) (car (car b))) ;比较X
)
(> (cadr (car a)) (cadr (car b))) ;比较Y
)
)
);重新排序:先上下后左右
)
);矩形分堆得到互不相交的矩形LST
)
;返回实体或对象最小边界框的WCS坐标(左下角和右上角)@Gu_xl
(defun K:GetWCSBox (obj / p1 p2 p3 p4 WCSBox)
(if (eq 'ENAME (type obj)) (setq obj (vlax-ename->vla-object obj)))
(vla-GetBoundingBox obj 'p1 'p3)
(setq p1 (vlax-safearray->list p1)
p3 (vlax-safearray->list p3)
p2 (list (car p1) (cadr p3) (caddr p1))
p4 (list (car p3) (cadr p1) (caddr p1))
)
(if (eq "AcDbSpline" (Vla-Get-ObjectName obj));样条曲线取投影
(progn
(setq WCSBox (mapcar
'(lambda (a b) (vlax-curve-getClosestPointToProjection obj a b t))
(list p1 p2 p3 p4)
'((1.0 0 0) (0 -1.0 0) (-1.0 0 0) (0 1.0 0))
)
)
(list
(apply 'mapcar (cons 'min WCSBox));表中最小
(apply 'mapcar (cons 'max WCSBox));表中最大
)
)
(list p1 p3)
)
)
;返回实体或对象最小边界框的UCS坐标(左下角和右上角)@Kucha
(defun K:GetUCSBox (obj / K:CvtMatrix UCSBox)
(if (eq 'ENAME (type obj)) (setq obj (vlax-ename->vla-object obj)))
;矩阵转换/坐标系转换
(defun K:CvtMatrix (from to)
(append
(mapcar
(function
(lambda (v o)
(append (trans v from to t) (list o))
)
)
'((1.0 0.0 0.0)
(0.0 1.0 0.0)
(0.0 0.0 1.0)
)
(trans '(0.0 0.0 0.0) to from)
)
'((0.0 0.0 0.0 1.0))
)
)
(vla-transformby obj (vlax-tmatrix (K:CvtMatrix 1 0)));对象转换到WCS
(setq UCSBox (K:GetWCSBox obj));获取转换后的最小矩形框(WCS)
(vla-transformby obj (vlax-tmatrix (K:CvtMatrix 0 1)));对象转换回UCS
UCSBox
)
;获取选择集所有实体的最小边界框表(WCS/UCS)@Kucha
(defun K:SSAllBoxLst (WCS TgtSS / i en SSBox)
(if TgtSS
(repeat (setq i (sslength TgtSS))
(setq en (ssname TgtSS (setq i (1- i))))
(setq SSBox
(cons
(if WCS (K:GetWCSBox en) (K:GetUCSBox en))
SSBox
)
)
)
)
SSBox
)
;获取选择集最小边界框表的最小值,即左下角(WCS/UCS)@Kucha
(defun K:SSBoxMinPT (WCS TgtSS / i en BoxMin MinPt)
(if TgtSS
(repeat (setq i (sslength TgtSS))
(setq en (ssname TgtSS (setq i (1- i))))
(setq BoxMin (car (if WCS (K:GetWCSBox en) (K:GetUCSBox en))))
(setq MinPt (mapcar 'min BoxMin (cond (MinPt) (BoxMin))))
)
)
MinPt
)
这个就是你在ucs下得到的包围盒角点与在wcs下是一致的,同时楼主改进后可以得到选择集的包围盒.不过,这个函数猜测可能会存在缺陷,原因是基础函数用到curve系列函数,该函数在大坐标时,可能出现问题. 这个挺好的,很多时候用的着 不错，要是能给个应用实例就好了
支持支持 tigcat 发表于 2024-3-2 19:16
这个就是你在ucs下得到的包围盒角点与在wcs下是一致的,同时楼主改进后可以得到选择集的包围盒.不过,这个函 ...
现在是能用比好用重要哈哈哈，大坐标没探索太深 尘缘一生 发表于 2024-3-2 19:16
有什么改动吗？ kucha007 发表于 2024-3-3 11:53
现在是能用比好用重要哈哈哈，大坐标没探索太深
楼主说的不错
页:
[1]
2