[已经解决]获取对象包围盒、最小包围盒-----(也适于UCS)

669423907

;;----------------=={ 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 LM:MinBoundingBox ( ss pr / an ba bb bm cn cv i l mb )
  (if ss
    (progn
      (setq bb
        (LM:ListBoundingBox
          (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 (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: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))
      )
    )
  )
)

;;------------------=={ List BoundingBox }==------------------;;
;;                                                            ;;
;;  Returns the coordinates of a rectangle framing all        ;;
;;  objects in a supplied list                                ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ? 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  lst - list of VLA-Objects to process                      ;;
;;------------------------------------------------------------;;
;;  Returns:  coordinates of rectangle framing objects        ;;
;;------------------------------------------------------------;;

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

;;--------------=={ Rotate Points by Matrix }==---------------;;
;;                                                            ;;
;;  Performs a Rotation transformation on a list of points    ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ? 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  l - list of points to be rotated                          ;;
;;  p - base point for rotation (in CS of Point List)         ;;
;;  a - angle of rotation                                     ;;
;;------------------------------------------------------------;;

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

;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

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



(defun c:test ( / s )
  (if (setq s (ssget "_:L"))
    (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))
      )
    )
  )
  (princ)
)

xiaxiang

为你那锅稀饭感到惋惜(≧^ω^≦)

emk

xiaxiang 发表于 2013-9-21 08:08
为你那锅稀饭感到惋惜(≧^ω^≦)

锅稀饭?和稀泥

mj0000

期待新版，支持

EL_JAY

回复可见啊

kwok

回复一下看看.

461045462

看看
谢谢楼主分享

成仔

429014673

看看                  

sachindkini

see hidden content in this post, please reply