获取实体或对象的WCS/UCS最小边界框

admin

1. ;返回实体或对象最小边界框的WCS坐标(左下角和右上角)@Gu采用xl
2. (defun K:GetWCSBox (obj / p1 p2 p3 p4 BoxLst)
3.     (if (eq 'ENAME (type obj))(setq obj (vlax-ename->vla-object obj)))
4.     (vla-GetBoundingBox obj 'p1 'p3)
5.     (setq p1 (vlax-safearray->list p1)
6.           p3 (vlax-safearray->list p3)
7.           p2 (list (car p1) (cadr p3) (caddr p1))
8.           p4 (list (car p3) (cadr p1) (caddr p1))
9.     )
10.     (if (eq "AcDbSpline" (Vla-Get-ObjectName obj));样条曲线取投影
11.         (progn
12.           (setq BoxLst (mapcar
13.                           '(lambda (a b) (vlax-curve-getClosestPointToProjection obj a b t))
14.                           (list p1 p2 p3 p4)
15.                           '((1.0 0 0) (0 -1.0 0) (-1.0 0 0) (0 1.0 0))
16.                        )
17.           )
18.           (list
19.               (apply 'mapcar (cons 'min BoxLst));表中最小
20.               (apply 'mapcar (cons 'max BoxLst));表中最大
21.           )
22.         )
23.         (list p1 p3)
24.     )
25. )

复制代码

1. ;返回实体或对象最小边界框的UCS坐标(左下角和右上角)@Kucha
2. (defun K:GetUCSBox (obj / K:CvtMatrix BoxLst)
3.   (if (eq 'ENAME (type obj))(setq obj (vlax-ename->vla-object obj)))
4.   ;矩阵转换/坐标系转换
5.   (defun K:CvtMatrix (from to)
6.     (append
7.       (mapcar
8.         (function
9.           (lambda (v o)
10.             (append (trans v from to t) (list o))
11.           )
12.         )
13.         '((1.0 0.0 0.0)
14.           (0.0 1.0 0.0)
15.           (0.0 0.0 1.0)
16.         )
17.         (trans '(0.0 0.0 0.0) to from)
18.       )
19.       '((0.0 0.0 0.0 1.0))
20.     )
21.   )
22.   (vla-transformby obj (vlax-tmatrix (K:CvtMatrix 1 0)));对象转换到WCS
23.   (setq BoxLst (K:GetWCSBox obj));获取转换后的最小矩形框(WCS)
24.   (vla-transformby obj (vlax-tmatrix (K:CvtMatrix 0 1)));对象转换回UCS
25.   BoxLst
26. )

复制代码