关于最小包围框添加对角线

669423907

好久以前下的程序，麻烦帮在包围框的4个顶点添加两条对角线，谢谢了
(entmake (list '(0 . "line")'(cons 10 p1)(cons 11 p3)))
(entmake (list '(0 . "line")'(cons 10 p2)(cons 11 p4)))
;;----------------=={ Minimum Bounding Box }==----------------;;
;;                                                            ;;
;;  Returns the coordinates of the minimum bounding rectangle ;;
;;  surrounding objects in a supplied selection set           ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ? 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  ss - selection set to process                             ;;
;;  pr - precision of calculation, 0 < pr < 1                 ;;
;;------------------------------------------------------------;;
;;  Returns: coordinates of minimum rectangle framing objects ;;
;;------------------------------------------------------------;;
;最小包围框

(defun c:zxkk( / s )
  (princ "\n绘制最小包容盒:")
  (if (setq s (ssget))
    (entmakex
      (append
        (list
          (cons 0 "LWPOLYLINE")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbPolyline")
          (cons 90 4)
          (cons 70 1)
        )
        (mapcar '(lambda ( p ) (cons 10 p)) (LM:MinBoundingBox s 0.01))
      )
    )
  )
(entmake (list '(0 . "line")'(cons 10 p1)(cons 11 p3)))
(entmake (list '(0 . "line")'(cons 10 p2)(cons 11 p4)))
  (princ)
)

(defun LM:MinBoundingBox ( ss pr / an ba bb bm cn cv i l mb )
  (if ss
    (progn
      (setq bb
        (LMistBoundingBox
          (repeat (setq i (sslength ss))
            (setq l (cons (vla-copy (vlax-ename->vla-object (ssname ss (setq i (1- i))))) l))
          )
        )
      )
      (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)))
            mb (cons 0.0 bb)
            an 0
      )
      (while (< (setq an (+ an pr)) pi)
        (foreach x l (vla-rotate x cv pr))
        (setq bb (LMistBoundingBox 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:RotatePointsByMatrix
        (mapcar
          (function
            (lambda ( a )
              (mapcar (function (lambda ( b ) ((eval b) (cdr mb)))) a)
            )
          )
         '((caar cadar) (caadr cadar) (caadr cadadr) (caar cadadr))
        )
        cn (- (car mb))
      )
    )
  )
)

(defun LMistBoundingBox ( 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)
  )
)

(defun LM:RotatePointsByMatrix ( l p a / m )
  (setq m
    (list
      (list (cos a) (sin (- a)) 0.0)
      (list (sin a) (cos a)     0.0)
      (list   0.0     0.0       1.0)
    )
  )
  (setq p (mapcar '- p (mxv m p)))
  (mapcar (function (lambda ( x ) (mapcar '+ (mxv m x) p))) l)
)

(defun mxv ( m v )
  (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

xiang19751218

(defun c:zxkk( / s )
  (princ "\n绘制最小包容盒:")
(setq s (ssget))
(setq bwhlst (LM:MinBoundingBox s 0.01))
  (if s
    (entmakex
      (append
        (list
          (cons 0 "LWPOLYLINE")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbPolyline")
          (cons 90 4)
          (cons 70 1)
        )
        (mapcar '(lambda ( p ) (cons 10 p))  bwhlst)
      )
    )
  )
(entmake (list '(0 . "line")(cons 10 (nth 0 bwhlst))(cons 11 (nth 2 bwhlst))))
(entmake (list '(0 . "line")(cons 10 (nth 1 bwhlst))(cons 11 (nth 3 bwhlst))))
  (princ)
)

(defun LM:MinBoundingBox ( ss pr / an ba bb bm cn cv i l mb )
  (if ss
    (progn
      (setq bb
        (LMistBoundingBox
          (repeat (setq i (sslength ss))
            (setq l (cons (vla-copy (vlax-ename->vla-object (ssname ss (setq i (1-

i))))) l))
          )
        )
      )
      (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)))
            mb (cons 0.0 bb)
            an 0
      )
      (while (< (setq an (+ an pr)) pi)
        (foreach x l (vla-rotate x cv pr))
        (setq bb (LMistBoundingBox 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:RotatePointsByMatrix
        (mapcar
          (function
            (lambda ( a )
              (mapcar (function (lambda ( b ) ((eval b) (cdr mb)))) a)
            )
          )
         '((caar cadar) (caadr cadar) (caadr cadadr) (caar cadadr))
        )
        cn (- (car mb))
      )
    )
  )
)

(defun LMistBoundingBox ( 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)
  )
)

(defun LM:RotatePointsByMatrix ( l p a / m )
  (setq m
    (list
      (list (cos a) (sin (- a)) 0.0)
      (list (sin a) (cos a)     0.0)
      (list   0.0     0.0       1.0)
    )
  )
  (setq p (mapcar '- p (mxv m p)))
  (mapcar (function (lambda ( x ) (mapcar '+ (mxv m x) p))) l)
)

(defun mxv ( m v )
  (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

669423907

顶起啊，有劳哪位大师方便帮一下忙啦

669423907

xiang19751218 发表于 2018-5-17 18:43
(defun c:zxkk( / s )
  (princ "\n绘制最小包容盒:")
(setq s (ssget))

顺便再请教一个问题：在得出4个点后，怎么才能删除那个包围框？

669423907

明白了，，，

xiang19751218

去掉(if s
    (entmakex
      (append
        (list
          (cons 0 "LWPOLYLINE")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbPolyline")
          (cons 90 4)
          (cons 70 1)
        )
        (mapcar '(lambda ( p ) (cons 10 p))  bwhlst)
      )
    )
  )
这几句即可

qhdycm2017

经过测试所得框并不是最小的