获取对象包围盒、最小包围盒-----(也适于UCS)
本帖最后由 /db_自贡黄明儒_ 于 2013-10-8 14:58 编辑第三版===================================================================
**** Hidden Message *****
第二版===================================================================
;;[功能] 图元当前坐标系下包围盒,4角点坐标
;|
4 = 左上；3 = 右上
1 = 左下；2 = 右下
|;
;;Flag : T时，返回最小包围盒角点；nil时，返回包围盒角点
;;说明 1 使用前加载须加载highflybird的程序Matrix-Lib.LSP
;; 2 作者保留本程序的一切权利，但你可以自由拷贝与复制、修改本程序用于非商业目的。
;; 3 自贡黄明儒 2013年9月27日
**** Hidden Message *****
第一版===================================================================
;;看了highflybird的矩阵和trans，实在没有悟透，请高手们出手，如何获取UCS下旋转过的对象的四个角点，在此首先表示感谢！！
;;主要是想用于求最小包围盒，以便对任何对象画中心线
;;[功能] 图元当前坐标系下包围盒,4角点坐标
;|
4 = 左上；3 = 右上
1 = 左下；2 = 右下
|;
;;Flag : T时，返回最小包围盒角点；nil时，返回包围盒角点
;;说明 1 使用前加载须加载highflybird的程序Matrix-Lib.LSP
;; 2 本程序是在G版的帮助和烧糊了一锅稀饭的代价下，试验出来的
;; 3 本程序是在highflybird选择集最小包围盒基础上发展而来
;; 4 不足之处是用了command,有待改善
;; 5 自贡黄明儒 2013年9月19日 中秋节
;; 6 使用者须保留以上信息
;;示例(HH:Ent4pt (car (entsel)) T),返回UCS坐标系下坐标
(defun HH:Ent4pt (ent Flag / ENT LST MATLSTMATRIXMAXPT MINPT
OBJ ORIGINREVMATUCSFLAG WCSORGX XDIR YDIR ZDIR
)
;;1 矩阵的变换与逆变换
(defun GetMatrix (lst org Revflag / I J MAT)
(setq mat (vlax-make-safearray vlax-vbDouble '(0 . 3) '(0 . 3)))
(setq i 0)
(repeat 3
(vlax-safearray-put-element mat i 3 (nth i org)) ;平移变换
(setq j 0)
(repeat 3
(if RevFlag
(vlax-safearray-put-element mat i j (nth j (nth i lst))) ;角度逆变换
(vlax-safearray-put-element mat i j (nth i (nth j lst))) ;角度的变换
)
(setq j (1+ j))
)
(setq i (1+ i))
)
(vlax-safearray-put-element mat 3 3 1)
mat ;返回矩阵
)
;;2 本程序主程序
(cond ((= (type ent) 'ENAME)
(setq obj (vlax-ename->vla-object ent))
)
((= (type ent) 'VLA-OBJECT) (setq obj ent))
(T (exit))
)
(and Flag (command "_.UCS" "NEW" "Object" ent))
;;先判断UCS是否与WCS相同。如是则取得UCS的X方向，
;;Y方向，Z方向，UCS原点及WCS的原点相对UCS的坐标点
;;然后得到UCS变换矩阵和到WCS的逆变换矩阵
(setq UcsFlag (getvar "WORLDUCS"))
(if (= UcsFlag 0) ;UCS与WCS不同
(setq UcsFlag T ;设置标志位为true
xdir (getvar "UCSXDIR") ;X方向矢量
ydir (getvar "UCSYDIR") ;Y方向矢量
zdir (MAT:vxv xdir ydir) ;X和Y的方向矢量的叉积
origin(getvar "UCSORG") ;原点
WcsOrg(trans '(0 0 0) 0 1) ;WCS的原点相对UCS的坐标
matLst(list xdir ydir zdir) ;旋转的变换矩阵表
matrix(GetMatrix matLst origin nil) ;从WCS到UCS(ocs)的变换矩阵
revMat(GetMatrix matLst WcsOrg T) ;从UCS(ocs)到WCS的变换矩阵
)
(setq UcsFlag nil) ;否则不予变换
)
;;在UCS下先变换物体到WCS下，取得物体的包围框，然后把物体变换回到UCS，并把矩形也变换回去
(and UcsFlag (vla-TransformBy obj revMat)) ;反变换到WCS
(vla-GetBoundingBox obj 'minPt 'maxPt) ;得到包围框
(setq minPt (vlax-safearray->list minPt))
;;(setq minPt (trans minPt ent 1))
(setq maxPt (vlax-safearray->list maxPt))
(and UcsFlag (vla-TransformBy obj matrix)) ;变换回到UCS
(and Flag (command "_.UCS" "p"))
(and UcsFlag (setq matrix (vlax-safearray->list matrix)))
(setq lst (list minPt
(list (car maxPt) (cadr minpt) (caddr minPt))
maxPt
(list (car minpt) (cadr maxPt) (caddr minPt))
)
) ;ocs坐标?
(and UcsFlag
(setq lst (mapcar '(lambda (x) (mat:mxp matrix x)) lst)) ;wcs坐标
(setq lst (mapcar '(lambda (x) (trans x ent 1)) lst)) ;ucs坐标
)
lst
)
;;下面的代码可以验证
;;148.1 [功能] 根据点表画多段线
(defun draw-pline1 (pts)
(command "_PLINE")
(mapcar 'command pts)
(command "c")
)
;;(draw-pline(HH:Ent4pt (car (entsel)) T))
;;(draw-pline(HH:Ent4pt (car (entsel)) nil))
支持黄老的钻研精神！ 下来学习学习 本帖最后由 /db_自贡黄明儒_ 于 2013-9-22 10:48 编辑
Lee Mac的程序，用highflybir的矩阵
Lee Mac是不断旋转选择集，求得最小包围盒，会不会太慢?
;;(LM:MinBoundingBox 选择集 精度[取值0~1]);返回包盒四角点
(defun LM:MinBoundingBox (ss pr / an ba bb bm cn cv i l mb)
;;VLA列表的包围盒的最小最大点列表
(defun LM:ListBoundingBox (lst / l1 l2 ll ur)
(foreach obj lst
(vla-getboundingbox obj 'll 'ur)
(setq l1 (cons (vlax-safearray->list ll) l1)
l2 (cons (vlax-safearray->list ur) l2)
)
)
(mapcar
(function (lambda (a b) (apply 'mapcar (cons a b))))
'(min max)
(list l1 l2)
)
)
(repeat (setq i (sslength ss))
(setq l (cons (vla-copy
(vlax-ename->vla-object (ssname ss (setq i (1- i))))
)
l
)
)
)
(setq bb (LM:ListBoundingBox l)) ;((-1437.59 2366.2 0) (-1429.07 2376.16 0))
(setq pr (* pr pi)
cn (apply 'mapcar
(cons (function (lambda (a b) (/ (+ a b) 2.0))) bb)
)
cv (vlax-3D-point cn) ;中点
bm (* (- (caadr bb) (caar bb)) (- (cadadr bb) (cadar bb))) ;x*y相当于面积
mb (cons 0.0 bb)
an 0
)
(while (< (setq an (+ an pr)) pi)
(foreach x l (vla-rotate x cv pr)) ;旋转
(setq bb (LM:ListBoundingBox l) ;旋转之后图元列表的最小包围盒
ba (* (- (caadr bb) (caar bb)) (- (cadadr bb) (cadar bb)))
)
(if (< ba bm)
(setq bm ba
mb (cons an bb)
)
)
)
(foreach x l (vla-delete x)) ;删除
(LM:RotateByMatrix
(mapcar
(function
(lambda (a)
(mapcar (function (lambda (b) ((eval b) (cdr mb)))) a)
)
)
'((caar cadar) (caadr cadar) (caadr cadadr) (caar cadadr))
)
cn ;旋转中心点
(- (car mb)) ;角度
)
)
支持楼主~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~· 看看{:soso_e102:}看看{:soso_e102:}看看{:soso_e102:} 支持一个 最小包围盒和 ucs下的包围盒，我应该都有源程序了，里面均没有用COMMAND,不知道楼主的要求跟我的那个有何区别？ 看看写的有什么不同
很给力!经验；技术要点；资料分享奖！
跟找9点一样给力 好好学习，谢谢
下来学习学习
Highflybird 发表于 2013-9-22 17:47
最小包围盒和 ucs下的包围盒，我应该都有源程序了，里面均没有用COMMAND,不知道楼主的要求跟我的那个有何区 ...
1 大师光临，不胜荣幸
2 实际情况是对于单个图元求最小包围盒的情况是很多的，我是想搞一个通用的最小包围盒
3 没有看到大量的最小包围盒，不然省去我很多事了
4 不使用command的矩阵，我已经找到(Mat:EntityMatrix ent),就是不知道我写的代码是否精简
/db_自贡黄明儒_ 发表于 2013-9-23 08:17
1 大师光临，不胜荣幸
2 实际情况是对于单个图元求最小包围盒的情况是很多的，我是想搞一个通用的最小包 ...
对于剪裁块的情况还需要考虑！
牢固 发表于 2013-9-23 13:40
对于剪裁块的情况还需要考虑！
考虑这种情况，我一点思路都没有。是不是模拟剪裁线，然后删除？