任意角度或UCS下的物体包围盒
本帖最后由 highflybird 于 2024-6-20 20:01 编辑以前写了一个任意角度或者UCS下的物体包围盒的求法，现把源码贡献上来：
下面是演示效果
运行命令 ： ttt
求出了每个物体在当前UCS下的包围盒， 然后再画出了选中物体的当前UCS下的包围盒。
对线段、曲线，文字，块均适用。
本帖最后由 尘缘一生 于 2024-6-21 05:55 编辑
highflybird 发表于 2024-6-20 19:09
我应该有个计算物体最小面积的包围盒程序。你搜索一下看看。
我组织了下子，测试，
1：本贴取得角度办法较快，但面积不是最小的包容:
2：从前 minarearectangle 函数办法较慢，但面积是最小的包容
;;;--------------------------
;;; 功能: 旋转点
;;; 输入: 点p，角度ang
;;; 输出: 中点位置
;;;-------------------------
(defun geo:rotbyangle (p ang / c s)
(setq c (cos ang))
(setq s (sin ang))
(list
(- (* c (car p)) (* s (cadr p)))
(+ (* s (car p)) (* c (cadr p)))
)
)
;;;------------------------
;;; 功能: 沿某一个方向的点集的包围盒
;;; 输入: pts--点集
;;; ang--方向与x轴夹角
;;; 输出: 包围盒点(wcs)
;;;--------------------------
(defun geo:getboxbyset (pts ang / pmin pmax)
(setq pts (mapcar (function (lambda (p) (geo:rotbyangle p (- ang)))) pts))
(setq pmin (apply 'mapcar (cons 'min pts)))
(setq pmax (apply 'mapcar (cons 'max pts)))
(mapcar
(function (lambda (p) (geo:rotbyangle p ang)))
(list
(list (car pmin) (cadr pmin))
(list (car pmax) (cadr pmin))
(list (car pmax) (cadr pmax))
(list (car pmin) (cadr pmax))
)
)
)
;点积(内积):p1p2 p1p3是否垂直，垂直为0;锐角为正，钝角为负 By Highflybird
;;定义向量的点积函数(向量A投影在向量B上的长度，但是它还要乘上B的长度)
(defun dot (p1 p2 p3 / x1 y1)
(setqx1 (car p1)
y1 (cadr p1)
)
(+ (* (- (car p2) x1) (- (car p3) x1))
(* (- (cadr p2) y1) (- (cadr p3) y1))
)
)
;;叉积(外积) By Highflybird
;;1 三角形之倍面积
;;2 p1 p2 p3 逆时针为正。
;;3 三点共线为0
(defun det (p1 p2 p3 / x2 y2)
(setqx2 (car p2) y2 (cadr p2))
(- (* (- x2 (car p3)) (- y2 (cadr p1))) (* (- x2 (car p1)) (- y2 (cadr p3))))
)
;;;========================================
;;;求凸壳直径的参数
;;;参数：逆时针的凸壳 h-------注意逆时针!!!
;;;返回值: (pair ang maxd) ((p1 p2) 角度、直径) modify qq:15290049
;;;========================================
(defun max-ang-distance (h / d m maxd p pair ang q u v w)
(setq q (cdr (append h h (list (car h))))) ;构造一个首尾循环的凸集,且起始点为凸壳的第二点
(setq maxd 0.0) ;初始化最小距离为0
(foreach u h ;依次检查凸壳的边
(setq v (car q)) ;循环集的第一点
(setq w (cadr q)) ;循环集的第二点
(setq m (sl:mid v w)) ;这两点的中点
(while (> (dot m u v) 0.0) ;如果夹角小于90度（即点积大于0）
(setq q (cdr q)) ;循环集推进
(setq v (car q)) ;取下一点
(setq w (cadr q)) ;下下一点
(setq m (sl:mid v w)) ;这两点的中点
)
(setq d (distance u v)) ;计算这时的最大距离
(if(> d maxd) ;如果大于前面的最大距离
(setq maxd d ;就替换前面的最大距离
pair (list u v) ;并记录这对点
)
)
)
(setq ang (angle (car pair) (cadr pair))) ;modify qq:15290049
(list pair ang maxd) ;返回这对点和角度、最大距离 ;modify qq:15290049
)
;;;==================
;;;graham扫描法求逆时针凸包
;;;==================
(defun graham-scan (plis / hullpt maxxpt sortpt p q)
(if (< (length plis) 3) ;3点以下
plis ;是本集合
(progn
(setq maxxpt (assoc (apply 'max (mapcar 'car plis)) plis));最右边的点
(setq sortpt (sort-by-angle-distance plis maxxpt)) ;分类点集
(setq hullpt (list (cadr sortpt) maxxpt)) ;开始的两点
(foreach n (cddr sortpt) ;从第3点开始
(setq hullpt (cons n hullpt)) ;把pi加入到凸集
(setq p (cadr hullpt)) ;pi-1
(setq q (caddr hullpt)) ;pi-2
(while (and q (> (det n p q) -1e-6)) ;如果左转
(setq hullpt (cons n (cddr hullpt))) ;删除pi-1点
(setq p (cadr hullpt)) ;得到新的pi-1点
(setq q (caddr hullpt)) ;得到新的pi-2点
)
)
(reverse hullpt) ;返回凸集
)
)
)
;;求中点函数-------(一级)------
(defun sl:mid (p1 p2)
(list (* (+ (car p1) (car p2)) 0.5) (* (+ (cadr p1) (cadr p2)) 0.5))
)
;;;以某点为基点，按照角度和距离分类点集
(defun sort-by-angle-distance (plis pt / )
(vl-sort plis
(function
(lambda (e1 e2 / ang1 ang2 )
(setq ang1 (angle pt e1))
(setq ang2 (angle pt e2))
(if (= ang1 ang2)
(< (distance pt e1) (distance pt e2))
(< ang1 ang2)
)
)
)
)
)
;;以下测试用（函数）---
;点表生成多段线--------(一级)-------
;线宽=nil，线宽为0;是否闭合=nil，不闭合 ;图层=nil，为当前图层 ;颜色=nil，为当前图层颜色;线型比例=nil，为1
;(slch:lwpolyline 点表 是否闭合 线宽 图层 颜色 线型比例)
;(slch:lwpolyline (list (1 2) (2 3)) T 2 "中心线" 6 5)
(defun slch:lwpolyline (lst dxf70 plwid lay lwplcol lwplbili)
(entmake
(append
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length lst)) ;点表
(if (= dxf70 T)
(cons 70 1);闭合与不闭合
(cons 70 0)
)
(if plwid
(cons 43 plwid) ;线宽
(cons 43 0)
)
(if lay
(cons 8 lay) ;图层
(cons 8 (getvar "CLAYER"))
)
(if lwplcol
(cons 62 lwplcol) ;颜色
(cons 62 256)
)
(if lwplbili
(cons 48 lwplbili) ;线型比例
(cons 48 (* 0.01 (getvar "DIMLFAC")))
)
)
(mapcar '(lambda (pt) (cons 10 pt)) lst)
)
)
)
;;测试主程序1--
;;结果：耗时较快
(defun c:tt (/ plis sel t0 ang)
(setq t0 (getvar "MILLISECS"))
(setq plis (Graham-scan (getpt (ssget)))) ;construct the CCW Hull of this set.
(setq ang (cadr (max-ang-distance plis))) ;modify qq:15290049
(setq plis (geo:getboxbyset plis ang)) ;qq:15290049
(slch:lwpolyline plis t nil nil nil nil)
(prompt (strcat "耗时" (rtos (/ (- (getvar "MILLISECS") t0) 1000.) 2 5) "秒"))
(princ)
)
;;测试主程序2--
;;结果：耗时较慢
(defun c:tt1 (/ plis sel t0 ang)
(setq t0 (getvar "MILLISECS"))
(setq plis (Graham-scan (getpt (ssget)))) ;construct the CCW Hull of this set.
(if (or (< (length plis) 3) (and (>= (length plis) 3) (<= (dot (car plis) (cadr plis) (caddr plis)) 0.0)))
(setq plis (reverse plis))
)
(setq plis (car (minarearectangle plis))) ;这是高飞大师的，最小面积包容较慢
(slch:lwpolyline plis t nil nil nil nil)
(prompt (strcat "耗时" (rtos (/ (- (getvar "MILLISECS") t0) 1000.) 2 5) "秒"))
(princ)
)
highflybird 发表于 2024-6-21 00:04
这两个目的不一样。一个是求最小的包围盒，一个是求指定角度下的包围盒。
嗯，高大师，那么面积最小时候这个角度求出来的函数，能组织个，就可以加快速度了不是？因为面积最小时候的凸包，用的多。 对于角度的取值，对于点集的话，最好能有个判定点集那个角度的包容盒所围成的面积最小，自动求得这个角度。
记得大师有哪个集成，如果和这个集成合并下子，做个点集，取这个角度的函数，单独取这个角度，就方便了。
版主,您好
这个代码是否对三维立体图形也有效呢? 感谢高飞鸟大佬的分享~ 谢谢高飞老师的无私分享。 感谢无私分享～ yaokui25 发表于 2024-6-20 18:12
版主,您好
这个代码是否对三维立体图形也有效呢?
也有效。不过要稍微处理一下。
谢谢高飞老师的无私分享。 highflybird 发表于 2024-6-20 18:29
也有效。不过要稍微处理一下。
嘿嘿
麻烦版主可否出一版可对三维立体图形有效的,可以计算出最小立方体呢;P yaokui25 发表于 2024-6-20 18:37
嘿嘿
麻烦版主可否出一版可对三维立体图形有效的,可以计算出最小立方体呢
算最小立方体的，恐怕有点麻烦。不能用这个计算。否则很慢。