明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
楼主: 自贡黄明儒

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

    [复制链接]
发表于 2013-9-20 21:44 | 显示全部楼层
;;----------------=={ 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)
)

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

点评

说下返回4角点的顺序吧?  发表于 2019-11-5 21:08
有不规则多边形的凸包多边形吗?不要高飞兄的,他的太长了,包罗万象,我需最简洁的  发表于 2018-5-26 11:34

评分

参与人数 1明经币 +1 收起 理由
自贡黄明儒 + 1 淡定

查看全部评分

回复 支持 1 反对 0

使用道具 举报

发表于 2013-9-21 08:08 来自手机 | 显示全部楼层
为你那锅稀饭感到惋惜(≧^ω^≦)
发表于 2013-9-21 08:59 | 显示全部楼层
xiaxiang 发表于 2013-9-21 08:08
为你那锅稀饭感到惋惜(≧^ω^≦)

锅稀饭?和稀泥
发表于 2013-9-21 09:59 | 显示全部楼层
期待新版,支持
发表于 2013-9-21 10:13 | 显示全部楼层
回复可见啊
发表于 2013-9-21 10:42 | 显示全部楼层
回复一下看看.
发表于 2013-9-21 11:41 | 显示全部楼层
看看
谢谢楼主分享
发表于 2013-9-21 14:16 | 显示全部楼层
发表于 2013-9-21 14:41 | 显示全部楼层
看看                  
发表于 2013-9-21 15:05 | 显示全部楼层
see hidden content in this post, please reply
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 00:57 , Processed in 0.184157 second(s), 20 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表