Autolisp凸包算法+最小外接矩形
本帖最后由 danier 于 2023-5-21 21:35 编辑最近研究了下凸包算法写了两个程序：
1、求点集的凸包（修复上版一个小bug）；
2、求点集的最小外接矩形。
未经严格测试，供大家参考~
;;;点集凸包
(defun c:tt1()
(L-entity-creatlwployline nil (l-point-convexpolygon (setq pt_lst (mapcar '(lambda(x)(cdr (assoc 10 (entget x)))) (L-sel->list (ssget '((0 . "POINT"))))))))
)
;;;点集最小外接矩形
(defun c:tt2()
(L-entity-creatlwployline nil (l-point-minrectangle (setq pt_lst (mapcar '(lambda(x)(cdr (assoc 10 (entget x)))) (L-sel->list (ssget '((0 . "POINT"))))))))
)
;;;-----------------------------------------------------------;;
;;; 获取点集的凸包
;;;-----------------------------------------------------------;;
;;; L-point-convexpolygon
;;; 输入： pt_lst>>>点集
;;; 输出： 多边形点集
;;; 示例：
;;;-----------------------------------------------------------;;
;;;-----------------------------------------------------------;;
(defun L-point-convexpolygon(pt_lst / pt0 i res)
(if (> (length pt_lst) 3)
(progn
(setq pt0 (car (setq pt_lst (vl-sort pt_lst '(lambda (p1 p2) (< (cadr p1) (cadr p2)) )))))
(setq pt_lst (vl-sort pt_lst '(lambda (p1 p2) (< (angle '(0 0 0) (L-point-subtract p1 pt0) ) (angle '(0 0 0) (L-point-subtract p2 pt0))))))
(setq i 0)
(setq res (append (list (cadr pt_lst)) (list (car pt_lst)) ))
(setq pt_lst (L-list-getnvalue pt_lst 2 (length pt_lst)))
(while (< i (length pt_lst))
(cond
((> (L-point-positiononline (nth i pt_lst)(nth 1 res) (nth 0 res)) 0)
(setq res (append (list (nth i pt_lst)) res))
)
((< (L-point-positiononline (nth i pt_lst)(nth 1 res) (nth 0 res)) 0)
(setq res (L-list-getnvalue res 1 (length pt_lst)))
(while(and (< (L-point-positiononline (nth i pt_lst)(nth 1 res) (nth 0 res)) 0) (> (length res) 1))
(setq res (L-list-getnvalue res 1 (length pt_lst)))
)
(setq res (append (list (nth i pt_lst)) res))
)
((= (L-point-positiononline (nth i pt_lst)(nth 1 res) (nth 0 res)) 0)
(setq res (L-list-getnvalue res 1 (length pt_lst)))
(setq res (append (list (nth i pt_lst)) res))
)
)
(setq i (1+ i))
)
(reverse res)
;;(setq res (append (list (nth (- (length pt_lst) 1) pt_lst)) res))
)
(setq res pt_lst)
)
)
;;;-----------------------------------------------------------;;
;;; 获取点集最小外接矩形
;;;-----------------------------------------------------------;;
;;; L-point-minrectangle
;;; 输入： pt_lst>>>点集
;;; 输出： 矩形点集
;;; 示例：(L-point-minrectangle(setq pt_lst (mapcar '(lambda(x)(cdr (assoc 10 (entget x)))) (L-sel->list (ssget)))))
(defun L-point-minrectangle(pt_lst / i res line m m_rev pt_tmp pt x_max x_min y_max y_min rect rect_area)
;; 获取凸包点集，并转换为相对坐标系
(setq pt_lst (mapcar '(lambda(x) (trans x 0 1)) (L-point-convexpolygon pt_lst)))
(setq pt_lst (append pt_lst (list (car pt_lst))))
(setq i 0)
(setq res nil)
;; 遍历凸包中的所有直线
(while (< i (- (length pt_lst) 1))
(PRINC i)
;; 获取直线
(setq line (list (nth i pt_lst) (nth (setq i (1+ i)) pt_lst)))
;; 获取当前直线相对当前用户坐标系的变换矩阵和逆变换矩阵
(setq m (L-mat-line (car line) (cadr line) nil))
(setq m_rev (L-mat-revline(car line) (cadr line) nil))
;; 所有点变换为相对line的相对坐标
(setq pt_tmp (mapcar '(lambda(pt) (mapcar '+ (L-mat-mxv (car m_rev) pt) (cadr m_rev))) pt_lst))
;; 获取最小、最大x
(setq pt_tmp (vl-sort pt_tmp '(lambda(pt1 pt2) (< (car pt1) (car pt2)))))
(setq x_min (car (nth 0 pt_tmp)))
(setq x_max (car (nth (- (length pt_tmp) 1) pt_tmp)))
;; 获取最小、最大y
(setq pt_tmp (vl-sort pt_tmp '(lambda(pt1 pt2) (< (cadr pt1) (cadr pt2)))))
(setq y_min (cadr (nth 0 pt_tmp)))
(setq y_max (cadr (nth (- (length pt_tmp) 1) pt_tmp)))
(setq rect (list (list x_min y_min 0) (list x_max y_min 0) (list x_max y_max 0) (list x_min y_max 0)))
(setq rect_area (* (- x_max x_min) (- y_max y_min)))
;; 矩形坐标转换为世界坐标系
(setq rect (mapcar '(lambda(pt) (trans (mapcar '+ (L-mat-mxv (car m) pt) (cadr m)) 1 0)) rect))
(setq res (append res (list (list rect_area rect))))
)
(setq res (vl-sort res '(lambda(x1 x2) (< (car x1) (car x2)))))
(cadr (car res))
)
;;;-----------------------------------------------------------;;
;;; 判断点在直线左侧、右侧、直线上
;;;-----------------------------------------------------------;;
;;; L-point-positiononline
;;; 输入： pt>>>需要判断的点
;;; pt1>>>直线起点
;;; pt2>>>直线终点
;;; 输出：等于0>在直线上，小于0>在直线右侧，大于0>在直线左侧
;;; 示例：
;;;-----------------------------------------------------------;;
;;;-----------------------------------------------------------;;
(defun L-point-positiononline(pt pt1 pt2)
(- (*(-(car pt1) (car pt))(- (cadr pt2) (cadr pt))) (*(-(car pt2) (car pt))(- (cadr pt1) (cadr pt))))
)
;;;-----------------------------------------------------------;;
;;; 两点加法
;;;-----------------------------------------------------------;;
;;; L-Point-Add、L-Point-subtract
;;; 输入：
;;; 输出：
;;; 示例：
;;;-----------------------------------------------------------;;
;;;-----------------------------------------------------------;;
(defun L-point-subtract(PT1 PT2)
(list (-(car pt1) (car pt2)) (-(cadr pt1) (cadr pt2)) (-(caddr pt1) (caddr pt2)))
)
;;;-----------------------------------------------------------;;
;;; 获取列表指定区间的值
;;;-----------------------------------------------------------;;
;;; L-list-getnvalue
;;; 输入：m>>>起点位置 列表第一位为0
;;; n>>>结束位置
;;; 输出：
;;; 示例：
;;;-----------------------------------------------------------;;
(defun L-list-getnvalue (lst m n / res i)
(setq res nil)
(if (and (= (type m) 'INT) (= (type n) 'INT))
(progn
(setq i m)
(while (and (setq l (nth i lst)) (< i (+ n m)))
(setq res (append res (list l)))
(setq i (1+ i))
)
)
)
res
)
;;;-----------------------------------------------------------;;
;;; 创建多段线
;;; L-entity-creatline
;;; 输入：
;;; 输出：
;;; 示例：
;;;-----------------------------------------------------------;;
(defun L-entity-creatlwployline (lay l_lst / i res)
(setq i 0)
(setq res nil)
(if (null lay)
(entmakex ((lambda(x)(setq res (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity")(cons 100 "AcDbPolyline")(cons 90 (length x))(cons 70 1))) (foreach lst x (setq res (append res (list (cons 10 lst))))) )l_lst))
(entmakex ((lambda(x)(setq res (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity")(cons 100 "AcDbPolyline")(cons 90 (length x))(cons 70 1) (cons 8 lay))) (foreach lst x (setq res (append res (list (cons 10 lst))))) )l_lst))
)
)
;;;-----------------------------------------------------------;;
;;; 列表、选择集互转
;;;-----------------------------------------------------------;;
;;; L-sel->listL-list->sel
;;; 输入：
;;; 输出：
;;; 示例：
;;;-----------------------------------------------------------;;
(defun L-sel->list(sel / res i)
(setq res nil)
(setq i 0)
(if (/= sel nil)
(repeat (sslength sel)
(setq res (append res (list (ssname sel i))))
(setq i (1+ i))
)
)
res
)
(defun L-list->sel (lst / res)
(setq res (ssadd))
(foreach l lst (setq res (ssadd l res)))
)
;;;-----------------------------------------------------------;;
;;; 向量的矩阵变换(向量乘矩阵)
;;;-----------------------------------------------------------;;
;;; L-mat-mxv
;;; 输入：
;;; 输出：
;;;-----------------------------------------------------------;;
(defun L-mat-mxv (m v)
(mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)
)
;;;-----------------------------------------------------------;;
;;; 矩阵相乘
;;;-----------------------------------------------------------;;
;;; L-mat-mxm
;;; 输入：
;;; 输出：
;;;-----------------------------------------------------------;;
(defun L-mat-mxm (m q)
(mapcar (function (lambda (r) (L-mat-mxv (L-mat-trp q) r))) m)
)
;;;-----------------------------------------------------------;;
;;; 矩阵转置
;;;-----------------------------------------------------------;;
;;; L-mat-trp
;;; 输入：
;;; 输出：
;;;-----------------------------------------------------------;;
(defun L-mat-trp (m)
(apply 'mapcar (cons 'list m))
)
;;;-----------------------------------------------------------;;
;;; 功能：直线的变换矩阵(平面变换)
;;;-----------------------------------------------------------;;
;;; L-mat-line
;;; 输入：pt1>>>直线起点
;;; pt2>>>直线终点
;;; sc>>>列表(x y z),直线x、y、z方向的缩放比例，为空时默认为1
;;; 输出：
;;; 示例：(setq m (L-mat-line (getpoint) (getpoint) nil)) (mapcar '+ (L-mat-mxv (car m) (getpoint)) (cadr m))
;;;-----------------------------------------------------------;;
(defun L-mat-line (pt1 pt2 sc / elst ang norm mat)
;;(setq pt1 (trans pt1 0 1))
;;(setq pt2 (trans pt2 0 1))
;; 直线与当前用户坐标系的夹角
(setq ang (angle pt1 pt2))
(if (or (null sc) (/= (type sc) 'LIST) (/= (length sc) 3)) (setq sc '(1 1 1)))
(list
;; 旋转、缩放变换矩阵
(setq mat
(L-mat-mxm
;; 单位矩阵
(list '(1.0 0.0 0.0) '(0.0 1.0 0.0) '(0.0 0.0 1.0))
(L-mat-mxm
;; 旋转矩形
(list (list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
;; 缩放矩阵
(list (list (car sc) 0.0 0.0)
(list 0.0 (cadr sc) 0.0)
(list 0.0 0.0 (caddr sc))
)
)
)
)
;; 位移矩阵
pt1
)
)
;;;-----------------------------------------------------------;;
;;; 功能：直线变换逆矩阵(平面变换)
;;;-----------------------------------------------------------;;
;;; L-mat-line
;;; 输入：pt1>>>直线起点
;;; pt2>>>直线终点
;;; sc>>>列表(x y z),直线x、y、z方向的缩放比例，为空时默认为1
;;; 输出：
;;; 示例：
;;;-----------------------------------------------------------;;
(defun L-mat-revline (pt1 pt2 sc / elst ang norm mat)
;;(setq pt1 (trans pt1 0 1))
;;(setq pt2 (trans pt2 0 1))
;; 直线与当前用户坐标系的夹角
(setq ang (- (angle pt1 pt2)))
(if (or (null sc) (/= (type sc) 'LIST) (/= (length sc) 3)) (setq sc '(1 1 1)))
(list
;; 旋转、缩放变换矩阵
(setq mat
(L-mat-mxm
;; 缩放矩阵
(list (list (/ 1 (car sc)) 0.0 0.0)
(list 0.0 (/ 1 (cadr sc)) 0.0)
(list 0.0 0.0 (/ 1 (caddr sc)))
)
(L-mat-mxm
;; 旋转矩形
(list (list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
;; 单位矩阵
(list '(1.0 0.0 0.0) '(0.0 1.0 0.0) '(0.0 0.0 1.0))
)
)
)
;; 位移矩阵
(mapcar '- (L-mat-mxv mat pt1))
)
)
(princ)
(defun c:tt ()
"点集的最小外接矩形"
(if (setq ss (ssget '((0 . "POINT"))))(xyp-Rectang (xyp-9pt ss 1) (xyp-9pt ss 9)))
(princ)
)
页:
[1]