1. ;;返回一个选择集的最小矩形包围盒
    2. ;;参数1：选择集
    3. (defun try-getbox-min (ss / ang0 ang1 angs angx ba0 ba1 bax bb0 bb1 bbx cn cv i k l ro temp)
    4.   (if ss
    5.     (progn
    6.             (setq i -1 
    7.                 l(repeat (sslength ss)
    8.                      (setq l(cons (vlax-ename->vla-object(ssname ss(setq i(1+ i)))) l))
    9.                  ));选择集转对象表
    10.             (setq
    11.                 bb1(try-GetBox l);包围盒
    12.                 cn (try-mid(car bb1)(cadr bb1));中心点
    13.                 cv (vlax-3D-point cn);创建3维点结构
    14.                 ba1 (apply '*(mapcar '- (car bb1)(cadr bb1)));包围盒面积
    15.       )
    16.             (setq ang1 0.0)
    17.             (setq ang0(* 0.25 pi)angs ang0);转45度
    18.             (foreach n l (vla-rotate n cv ang0))
    19.             (setq bb0 (try-GetBox l);取得包围盒
    20.                 ba0 (apply '*(mapcar '- (car bb0)(cadr bb0)));包围盒面积
    21.             )
    22.             (if (> ba0 ba1);对换
    23.                 (setq 
    24.                     temp ang0
    25.                     ang0 ang1
    26.                      ang1 temp
    27.                     temp ba0
    28.                     ba0 ba1
    29.                     ba1 temp
    30.                     temp bb0
    31.                     bb0 bb1
    32.                     bb1 temp    
    33.                 )
    34.             );0小的面积
    35.             (repeat 2
    36.                 (while (> (abs(- ang1 ang0))(* 0.000001 pi))
    37.                     (if k (setq angx ang1 k nil);二次循环
    38.                         (setq angx(* 0.5(+ ang0 ang1)));中间角度
    39.                     )
    40.                     (setq ro(- angx angs)angs angx)
    41.                     (foreach n l (vla-rotate n cv ro))
    42.                     (setq bbx (try-GetBox l);取得包围盒
    43.                         bax (apply '*(mapcar '- (car bbx)(cadr bbx)));包围盒面积
    44.                     )
    45.                     (if (< bax ba0);对换
    46.                         (setq 
    47.                             ba1 ba0 ang1 ang0 bb1 bb0
    48.                             ba0 bax ang0 angx bb0 bbx)
    49.                         (setq ang1 angx ba1 bax bb1 bbx)
    50.                     )
    51.                 )
    52.                 (foreach n l (vla-rotate n cv (- ang0)))
    53.                 (setq ang1 (- ang0(* (if (/= 0.0 ang0)(- 0.25)0.25) pi))angs 0.0 k t)
    54.             )
    55.       (try-pts-rotate (try-pt2-to-pt4 (car bb0)(cadr bb0)) cn (- ang0))
    56.     )
    57.   )
    58. )
    59. ;;取两点的中点(二维)
    60. ;;例子(try-mid 点1 点2)
    61. (defun try-mid(p1 p2)(mapcar '(lambda (x y) (* 0.5 (+ x y))) p1 p2))
    62. ;;pt点围绕p0点旋转ang弧度
    63. (defun try-pt-rotate (pt p0 ang)
    64. (polar p0 (+ (angle p0 pt) ang) (distance pt p0))
    65. )
    66. ;;点表围绕p0点旋转ang弧度
    67. (defun try-pts-rotate(lst p0 ang)
    68. (mapcar '(lambda(x)(try-pt-rotate x p0 ang))lst)
    69. )
    70. ;;根据两点坐标返回4个点坐标
    71. (defun try-pt2-to-pt4 (pt1 pt2)
    72.     (list (list (car pt1)(cadr pt1)) (list(car pt1)(cadr pt2))(list (car pt2)(cadr pt2))(list (car pt2)(cadr pt1)))
    73. )
    78. ;;================
    79. ;取得对象最小包围盒；参数 1、对象(表)/图元名(表)/选择集
    80. ;;注意，当选择集有大量图元时速度较慢，1万个图元可能接近1秒
    81. (defun try-getbox (e / en i l max1 min1 pt1 pt2 sn tx1 tx2 ty1 ty2 tye x1 x2 y1 y2)
    82.     (setq tye(type e))
    83.     (cond 
    84.         ((= 'VLA-object tye)
    85.             (vla-GetBoundingBox e 'p1 'p2);取得包容图元的最大点和最小点
    86.             (setq min1 (vlax-safearray->list p1));把变体数据转化为表
    87.             (setq max1 (vlax-safearray->list p2));把变体数据转化为表
    88.             (list min1 max1)
    89.         )
    90.         ((= 'ENAME tye)
    91.             (try-GetBox (vlax-ename->vla-object e))
    92.         )
    93.         ((or(= 'LIST tye)(= 'PICKSET tye))
    94.             (if (= 'PICKSET tye)(setq e (repeat (sslength ss)
    95.                      (setq l(cons (vlax-ename->vla-object(ssname ss(setq i(1+ i)))) l))
    96.                  )))
    97.             (if (= ENAME(type(car e)))(setq e(mapcar 'vlax-ename->vla-object e)))
    100.             (vla-getboundingbox (car e) 'pt1 'pt2);获取单个图元包盒
    101.             (setq 
    102.                 pt1(vlax-safearray->list pt1)
    103.                 pt2 (vlax-safearray->list pt2)
    104.                 tx1 (car pt1)
    105.                 ty1 (cadr pt1)
    106.                 tx2 (car pt2)
    107.                 ty2 (cadr pt2)
    108.             )
    109.             (setq i 0)
    110.             (setq sn (length e))
    111.             (repeat (1- sn)
    112.                 (setq en (nth (setq i (1+ i))e))
    113.                 (vla-getboundingbox en 'pt1 'pt2);获取单个图元包盒
    114.                 (setq 
    115.                     pt1(vlax-safearray->list pt1)
    116.                     pt2 (vlax-safearray->list pt2)
    117.                     x1 (car pt1)
    118.                     y1 (cadr pt1)
    119.                     x2 (car pt2)
    120.                     y2 (cadr pt2))
    121.                 (if (> tx1 x1)(setq tx1 x1))
    122.                 (if (> ty1 y1)(setq ty1 y1))
    123.                 (if (< tx2 x2)(setq tx2 x2))
    124.                 (if (< ty2 y2)(setq ty2 y2))
    125.             )
    126.             (list (list tx1 ty1) (list tx2 ty2))
    127.         )
    128.     )
    129. )
    132. ;;以下是应用例子
    133. (defun c:tt (/ ls)
    134.     (setq ls(try-getbox-min (ssget)))
    135.     (command "pline" "_non"(car ls)"_non"(cadr ls)"_non"(caddr ls)"_non"(cadddr ls) "c")
    136. )