;;----------------=={ 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 发表于 2013-9-21 08:08 static/image/common/back.gif
为你那锅稀饭感到惋惜(≧^ω^≦)
锅稀饭?和稀泥
期待新版，支持
回复可见啊
回复一下看看.
看看
谢谢楼主分享
看看
see hidden content in this post, please reply