任意角度或UCS下的物体包围盒

highflybird · 发表于 2024-6-20 18:05

本帖最后由 highflybird 于 2024-6-20 20:01 编辑

以前写了一个任意角度或者UCS下的物体包围盒的求法，现把源码贡献上来：

下面是演示效果

运行命令： ttt
求出了每个物体在当前UCS下的包围盒，然后再画出了选中物体的当前UCS下的包围盒。

对线段、曲线，文字，块均适用。

尘缘一生 · 发表于 2024-6-20 23:59

本帖最后由尘缘一生于 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)
(setq x1 (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)
(setq x2 (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)
)

;;;-------------------------- 
;;; 功能: 旋转点 
;;; 输入: 点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) 
  (setq  x1 (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) 
  (setq  x2 (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) 
)

尘缘一生 · 发表于 2024-6-21 05:58

highflybird 发表于 2024-6-21 00:04
这两个目的不一样。一个是求最小的包围盒，一个是求指定角度下的包围盒。

嗯，高大师，那么面积最小时候这个角度求出来的函数，能组织个，就可以加快速度了不是？因为面积最小时候的凸包，用的多。

尘缘一生 · 发表于 2024-6-20 18:33

对于角度的取值，对于点集的话，最好能有个判定点集那个角度的包容盒所围成的面积最小，自动求得这个角度。

记得大师有哪个集成，如果和这个集成合并下子，做个点集，取这个角度的函数，单独取这个角度，就方便了。

yaokui25 · 发表于 2024-6-20 18:12

版主,您好
这个代码是否对三维立体图形也有效呢?

czb203 · 发表于 2024-6-20 18:18

感谢高飞鸟大佬的分享~

hubeiwdlue · 发表于 2024-6-20 18:20

谢谢高飞老师的无私分享。

jkop · 发表于 2024-6-20 18:27

感谢无私分享～

highflybird · 发表于 2024-6-20 18:29

yaokui25 发表于 2024-6-20 18:12
版主,您好
这个代码是否对三维立体图形也有效呢?

也有效。不过要稍微处理一下。

清水白粥 · 发表于 2024-6-20 18:30

谢谢高飞老师的无私分享。

yaokui25 · 发表于 2024-6-20 18:37

highflybird 发表于 2024-6-20 18:29
也有效。不过要稍微处理一下。

嘿嘿
麻烦版主可否出一版可对三维立体图形有效的,可以计算出最小立方体呢

highflybird · 发表于 2024-6-20 18:39

yaokui25 发表于 2024-6-20 18:37
嘿嘿
麻烦版主可否出一版可对三维立体图形有效的,可以计算出最小立方体呢

算最小立方体的，恐怕有点麻烦。不能用这个计算。否则很慢。

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

[【高飞鸟】] 任意角度或UCS下的物体包围盒

本帖子中包含更多资源

评分

本帖子中包含更多资源