本帖最后由 自贡黄明儒 于 2013-9-18 10:06 编辑
namezg 发表于 2013-9-17 19:40 http://bbs.mjtd.com/static/image/common/back.gif
最近刚写的
我用此得出的结果好象不对
你的mxp同highflybir论矩阵中的MAT:mxp有什么差别？
;;下面的代码可以求UCS下任何对象的四个角点，但太罗索
;;哪位高手优化一下
;;考虑UCS,照搬highflybird的程序
;|
4 = 左上；3 = 右上
1 = 左下；2 = 右下
|;
;;(HH:Ename4pt (car (entsel))),返回UCS坐标系下坐标
(defun HH:Ename4pt (ent / LASTENTLST MATLST MATRIX
MAXPT MINPT OBJ ORIGIN REVMAT UCSFLAG
WCSORG XDIR YDIR ZDIR
)
;;1 矩阵的变换与逆变换
(defun GetMatrix (lst org Revflag / I J MAT)
(setq mat (vlax-make-safearray vlax-vbDouble '(0 . 3) '(0 . 3)))
;;初始化一个4X4的矩阵
(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 构造矩形
(defun Make-Rectange (pt1 pt2)
(entmake
(list
'(0 . "LWPOLYLINE") ;轻多段线
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 4) ;四个顶点
'(70 . 1) ;闭合
(cons 38 (caddr pt1)) ;高程
(cons 10 (list (car pt1) (cadr pt1))) ;左下角
(cons 10 (list (car pt2) (cadr pt1))) ;右下角
(cons 10 (list (car pt2) (cadr pt2))) ;右上角
(cons 10 (list (car pt1) (cadr pt2))) ;左上角
(cons 210 '(0 0 1)) ;法线方向
)
)
)
;;3 本程序主程序
(cond ((= (type ent) 'ENAME)
(setq obj (vlax-ename->vla-object ent))
)
((= (type ent) 'VLA-OBJECT) (setq obj ent))
(T (exit))
)
(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的变换矩阵
revMat(GetMatrix matLst WcsOrg T) ;从UCS到WCS的变换矩阵
)
(setq UcsFlag nil) ;否则不予变换
)
;;在UCS下先变换物体到WCS下，取得每个物体的包围框，
;;求出包围框集合的最小XY，最大XY，并用矩形框画出来
;;然后把物体变换回到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
(command "_.UCS" "p")
(and
(make-Rectange minPt maxPt) ;构造边框
UcsFlag ;如果UCS的话
(vla-TransformBy (vlax-ename->vla-object (entlast)) matrix)
)
(foreach x (entget (entlast))
(if (equal (car x) 10)
(setq lst (cons (cdr x) lst))
)
)
;;(REVERSE lst);返回世界坐标系下坐标
(mapcar '(lambda (x) (trans x ent 1)) (REVERSE lst))
)
本帖最后由 namezg 于 2013-9-18 20:53 编辑
我这边没有问题，获得的是对象UCS包围盒四角点的WCS坐标(注意不是UCS坐标)
而我测试你发的却是有问题的，绘制的矩形不正确。
本帖最后由 自贡黄明儒 于 2013-9-18 22:22 编辑
我发的图就是用12楼的代码画出来的，应该没有问题呀，只不过写得不好
自贡黄明儒 发表于 2013-9-17 16:46 static/image/common/back.gif
我是想直接取得对象的四个角点，而且是通用的。
确又搞不定
;;返回四个角点WCS坐标
(princ
(list
(mat:mxp (vlax-safearray->listmatrix) minPt) ;_ 左下角坐标
(mat:mxp (vlax-safearray->listmatrix) (list (car minpt) (cadr maxPt) (caddr minPt))) ;_ 左上角坐标
(mat:mxp (vlax-safearray->listmatrix) maxPt) ;_ 右上角坐标
(mat:mxp (vlax-safearray->listmatrix) (list (car maxPt) (cadr minpt) (caddr minPt))) ;_ 右下角坐标
))
红色的包围盒是用我的函数获得的。黄色的包围盒使用12楼的函数获得的。
namezg 发表于 2013-9-18 23:08
红色的包围盒是用我的函数获得的。黄色的包围盒使用12楼的函数获得的。
最小包围盒和平行与ucs的包围盒！
楼主不是要ucs坐标系下的包围盒吗?难道要的是最小包围盒.
namezg 发表于 2013-9-19 16:02
楼主不是要ucs坐标系下的包围盒吗?难道要的是最小包围盒.
两种情况都搞定了，还需要验证一下，电脑出问题了！
不用command的程序以后再写