【K:GetEntUCSBox】最小UCS边界框
改写自G版的最小边界框。以往获取边界框的函数, 框边缘都平行WCS，没有做转换，用在我这个程序就会出问题了http://bbs.mjtd.com/thread-187517-1-1.html于是我做了改写，使得框平行于当前坐标系，返回的坐标也是基于当前坐标系。这样UCS下合并边界框啥的就没问题了。
;获取实体最小外接矩形的坐标,矩形边框平行于当前坐标系
(defun K:GetEntUCSBox (en / K:ConvertTMatrix obj Lst p1 p2 p3 p4)
(setq obj (vlax-ename->vla-object en))
;矩阵转换/坐标系转换
(defun K:ConvertTMatrix (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))
)
)
(if
(and
(not (K:CatchApply 'vla-transformby (list obj (vlax-tmatrix (K:ConvertTMatrix 1 0)))));对象转换到WCS
(not (K:CatchApply 'vla-GetBoundingBox (list obj 'p1 'p3)))
(not (K:CatchApply 'vla-transformby (list obj (vlax-tmatrix (K:ConvertTMatrix 0 1)))));对象转换回UCS
)
(progn
(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 "SPLINE" (cdr (assoc 0 (entget en))))
(progn
(setq Lst
(mapcar
'(lambda (a b)(vlax-curve-getClosestPointToProjection en 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 Lst))
(apply 'mapcar (cons 'max Lst))
)
)
(list p1 p3)
)
)
)
)
;通用函数
;如果不成功则抓取错误，如果成功就执行程序
(defun K:CatchApply (fun args / result)
(if
(not
(vl-catch-all-error-p
(setq result (vl-catch-all-apply
(if (= 'SYM (type fun)) fun (function fun))
args
)
)
)
)
result
)
)
顶上顶上顶上 那批打用上以后，不是可以打印旋转了一定角度的图框了。 lxl217114 发表于 2023-6-30 11:57
那批打用上以后，不是可以打印旋转了一定角度的图框了。
是的，不过这个是平行ucs。你说的那种leemac有一个最小边界框，感觉更适合
页:
[1]