获取实体或对象的WCS/UCS最小边界框
;返回实体或对象最小边界框的WCS坐标(左下角和右上角)@Gu采用xl(defun K:GetWCSBox (obj / p1 p2 p3 p4 BoxLst)
(if (eq 'ENAME (type obj))(setq obj (vlax-ename->vla-object obj)))
(vla-GetBoundingBox obj 'p1 'p3)
(setq p1 (vlax-safearray->list p1)
p3 (vlax-safearray->list p3)
p2 (list (car p1) (cadr p3) (caddr p1))
p4 (list (car p3) (cadr p1) (caddr p1))
)
(if (eq "AcDbSpline" (Vla-Get-ObjectName obj));样条曲线取投影
(progn
(setq BoxLst (mapcar
'(lambda (a b) (vlax-curve-getClosestPointToProjection obj a b t))
(list p1 p2 p3 p4)
'((1.0 0 0) (0 -1.0 0) (-1.0 0 0) (0 1.0 0))
)
)
(list
(apply 'mapcar (cons 'min BoxLst));表中最小
(apply 'mapcar (cons 'max BoxLst));表中最大
)
)
(list p1 p3)
)
)
;返回实体或对象最小边界框的UCS坐标(左下角和右上角)@Kucha
(defun K:GetUCSBox (obj / K:CvtMatrix BoxLst)
(if (eq 'ENAME (type obj))(setq obj (vlax-ename->vla-object obj)))
;矩阵转换/坐标系转换
(defun K:CvtMatrix (from to)
(append
(mapcar
(function
(lambda (v o)
(append (trans v from to t) (list o))
)
)
'((1.0 0.0 0.0)
(0.0 1.0 0.0)
(0.0 0.0 1.0)
)
(trans '(0.0 0.0 0.0) to from)
)
'((0.0 0.0 0.0 1.0))
)
)
(vla-transformby obj (vlax-tmatrix (K:CvtMatrix 1 0)));对象转换到WCS
(setq BoxLst (K:GetWCSBox obj));获取转换后的最小矩形框(WCS)
(vla-transformby obj (vlax-tmatrix (K:CvtMatrix 0 1)));对象转换回UCS
BoxLst
)
页:
[1]