Autolisp凸包算法+最小外接矩形

danier · 发表于 2023-5-17 22:56:46

本帖最后由 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->list L-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: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 (
        (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 (
    (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)) (
        (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->list  L-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)

xyp1964 · 发表于 2023-5-18 23:06:00

(defun c:tt ()
  "点集的最小外接矩形"
  (if (setq ss (ssget '((0 . "POINT"))))(xyp-Rectang (xyp-9pt ss 1) (xyp-9pt ss 9)))
  (princ)
)

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

[源码] Autolisp凸包算法+最小外接矩形

本帖子中包含更多资源

评分