获取对象包围盒、最小包围盒-----(也适于UCS)

/db_自贡黄明儒_

第三版===================================================================

游客，如果您要查看本帖隐藏内容请回复

第二版===================================================================
;;[功能] 图元当前坐标系下包围盒,4角点坐标
;|
4 = 左上；3 = 右上
1 = 左下；2 = 右下
|;
;;Flag : T时，返回最小包围盒角点；nil时，返回包围盒角点
;;说明 1 使用前加载须加载highflybird的程序Matrix-Lib.LSP
;;     2 作者保留本程序的一切权利，但你可以自由拷贝与复制、修改本程序用于非商业目的。
;;     3 自贡黄明儒 2013年9月27日

游客，如果您要查看本帖隐藏内容请回复

第一版===================================================================

;;看了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   MATLST  MATRIX  MAXPT   MINPT
    OBJ   ORIGIN  REVMAT  UCSFLAG WCSORG  X   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))

Free-Lancer

支持黄老的钻研精神！

819534890

下来学习学习

/db_自贡黄明儒_

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))      ;角度
  )
)

zhangq_cai1

支持楼主~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~·

我的我啊我

看看{:soso_e102:}看看{:soso_e102:}看看{:soso_e102:}

ScmTools

支持一个

Highflybird

最小包围盒和 ucs下的包围盒，我应该都有源程序了，里面均没有用COMMAND,不知道楼主的要求跟我的那个有何区别？

namezg

看看写的有什么不同

守仁格竹GM

很给力!经验；技术要点；资料分享奖！
跟找9点一样给力

zytyd

好好学习，谢谢

1993063

下来学习学习

/db_自贡黄明儒_

Highflybird 发表于 2013-9-22 17:47
最小包围盒和 ucs下的包围盒，我应该都有源程序了，里面均没有用COMMAND,不知道楼主的要求跟我的那个有何区 ...

1 大师光临，不胜荣幸
2 实际情况是对于单个图元求最小包围盒的情况是很多的，我是想搞一个通用的最小包围盒
3 没有看到大量的最小包围盒，不然省去我很多事了
4 不使用command的矩阵，我已经找到(Mat:EntityMatrix ent),就是不知道我写的代码是否精简

牢固

/db_自贡黄明儒_ 发表于 2013-9-23 08:17
1 大师光临，不胜荣幸
2 实际情况是对于单个图元求最小包围盒的情况是很多的，我是想搞一个通用的最小包 ...

对于剪裁块的情况还需要考虑！

/db_自贡黄明儒_

牢固 发表于 2013-9-23 13:40
对于剪裁块的情况还需要考虑！

考虑这种情况，我一点思路都没有。是不是模拟剪裁线，然后删除？