引用一段源码，来自PF工具箱



  2. ;【PF工具箱--自动边界盒】
  3. (defun c:bjh (/ ss i l1 l2 ll ur os d)
  4.    (setq os (getvar 'osmode))
  5.    (PRINC "\n【PF工具箱--QQ交流群：214654218】--自动边界盒 ")(PRINC)  
  6.    (setq d (getreal "\n偏距<5>"))
  7.    (if (null d)
  8.      (setq d 5)
  9.    )
  10.    (setq ss (ssget))
  11.    (repeat (setq i (sslength ss))
  12.      (vla-getboundingbox
  13.        (vlax-ename->vla-object (ssname ss (setq i (1- i))))
  14.        'll
  15.        'ur
  16.      )
  17.      (setq l1 (cons (vlax-safearray->list ll) l1)
  18.            l2 (cons (vlax-safearray->list ur) l2)
  19.      )
  20.    )
  21.    (mapcar 'set
  22.            (list 'll 'ur)
  23.            (mapcar '(lambda (a b) (apply 'mapcar (cons a b)))
  24.                    '(min max)
  25.                    (list l1 l2)
  26.            )
  27.    )
  28.    (command
  29.      "rectang"
  30.      (trans (polar ll (* pi 1.25) (setq d (sqrt (+ (* d d) (* d d)))))
  31.             0
  32.             1
  33.      )
  34.      (trans (polar ur (* pi 0.25) d) 0 1)
  35.    )
  36.    (setvar 'osmode os)
  37.    (princ)
  38. )





程序很好，但是针对框选的两点，来生成边界框；假如图形中有多个需要框选的“范围”，这些“范围”，如何被批量的识别及生成边界框，是个问题；





网友答: 本帖最后由 yoyoho 于 2023-12-9 22:58 编辑

;;框选物体画框 By Gu_xl 明经通道 2014.05.12
;;新增物件 模糊距离
;;新增包围盒 外偏距离
(defun c:mBox (/ BOX INTERSECT RECTANG SS N L A L1 FLAG B C)

   (IF (= DIST2 NIL)
       (SETQ DIST2 50)  ;;;变数值需预设
   )
      (IF (/= DIST2 NIL) (SETQ DIST2-S DIST2) (SETQ DIST2 50))
        (PRINC "\n 物件 模糊距离 (")(PRINC (FIX DIST2))(PRINC "):")
    (setq DIST2 (GETDIST))
    (IF (= DIST2 NIL)(SETQ DIST2 DIST2-S))

   (IF (= DIST3 NIL)
       (SETQ DIST3 10)  ;;;变数值需预设
   )
      (IF (/= DIST3 NIL) (SETQ DIST3-S DIST3) (SETQ DIST3 10))
        (PRINC "\n 包围盒 外偏距离 (")(PRINC (FIX DIST3))(PRINC "):")
    (setq DIST3 (GETDIST))
    (IF (= DIST3 NIL)(SETQ DIST3 DIST3-S))

    (setq DIST4 (- DIST2 DIST3))

(defun box (e / p1 p2 p3 p4 obj)
    (setq obj (vlax-ename->vla-object e))
    (vla-GetBoundingBox obj 'p1 'p3)
    (setq p1 (vlax-safearray->list p1)
          p3 (vlax-safearray->list p3)
          p2 (list (car p1) (cadr p3) (caddr p1))
          p4 (list (car p3) (cadr p1) (caddr p1))
    )
    (if (= "SPLINE" (cdr (assoc 0 (entget e))))
      (progn
        (SETQ lst
               (mapcar '(lambda (a b)
                          (vlax-curve-getClosestPointToProjection e a b t)
                        )
                       (list p1 p2 p3 p4)
                       '((1.0 0 0) (0 -1.0 0) (-1.0 0 0) (0 1.0 0))
               )
        )
        (list
          (apply 'mapcar (cons 'min lst))
          (apply 'mapcar (cons 'max lst))
        )
      )
      ;(SETQ P1 (mapcar '+ P1 (LIST (* DIST2 -1) (* DIST2 -1))))      ;;;DIST2包围盒外偏距离
      ;(SETQ P3 (mapcar '+ P3 (LIST (* DIST2 1) (* DIST2 1))))
      ;(SETQ P11 (LIST (* -1 DIST2) (* -1  DIST2)))
      ;(SETQ P1 (mapcar '+ P1 P11))      ;;;DIST2包围盒外偏距离
      (list p1 p3)
    )
)
  (defun intersect (a b)
    (if
      (or
        (and
          (<= (caar a) (caar b) (caadr a))
          (<= (cadar a) (cadar b) (cadadr a))
        )
        (and
          (<= (caar a) (caar b) (caadr a))
          (<= (cadar a) (cadadr b) (cadadr a))
        )
        (and
          (<= (caar a) (caadr b) (caadr a))
          (<= (cadar a) (cadadr b) (cadadr a))
        )
        (and
          (<= (caar a) (caadr b) (caadr a))
          (<= (cadar a) (cadar b) (cadadr a))
        )

      )
       (list
         (apply 'mapcar (cons 'min (append a b)))
         (apply 'mapcar (cons 'max (append a b)))
       )
    )
  )
  (defun rectang (a b)
    (entmake
      (list
        '(0 . "LWPOLYLINE")
        '(100 . "AcDbEntity")
        '(8 . "0")  ;;;'(8 . "辅助线")
        '(62 . 256)
        '(100 . "AcDbPolyline")
        '(90 . 4)
        '(70 . 1)
        (cons 10 a)
        (list 10 (car a) (cadr b))
        (cons 10 b)
        (list 10 (car b) (cadr a))
      )
    )
  )
  (if (setq ss (ssget))
    (progn
      (repeat (setq n (sslength ss))
        (SETQ PTS (box (ssname ss (setq n (1- n)))))
        (SETQ P1 (mapcar '+ (NTH 0 PTS) (LIST (* DIST2 -1) (* DIST2 -1))))
        (SETQ P3 (mapcar '+ (NTH 1 PTS) (LIST (* DIST2 1) (* DIST2 1))))
        (setq l (cons (list P1 P3) l))
      )
      (setq l
             (vl-sort
               l
               '(lambda (a b)
                  (if (equal (caar a) (caar b) 1e-3)
                    (if (equal (cadar a) (cadar b) 1e-3)
                      (if (equal (caadr a) (caadr b) 1e-3)
                        (< (cadadr a) (cadadr b))
                        (< (caadr a) (caadr b))
                      )
                      (< (cadar a) (cadar b))
                    )
                    (< (caar a) (caar b))
                  )
                )
             )
      )
      (setq a (car l)
            l (cdr l)
      )
      (while l
        (setq l1   nil
              flag nil
        )
        (while l
          (setq b (car l)
                l (cdr l)
          )
          (if (setq c (intersect a b))
            (setq a c
                  flag t
            )
            (setq l1 (cons b l1))
          )
        )
        (setq l (reverse l1))
        (if (not flag)
          (progn
            (rectang (mapcar '+ (car a) (LIST (* DIST4 1) (* DIST4 1)))
                     (mapcar '+ (cadr a) (LIST (* DIST4 -1) (* DIST4 -1)))
            )
            (setq a (car l)
                  l (cdr l)
            )
          )
        )
        (if (not l)
          (rectang (mapcar '+ (car a) (LIST (* DIST4 1) (* DIST4 1)))
                   (mapcar '+ (cadr a) (LIST (* DIST4 -1) (* DIST4 -1)))
          )
        )
      )
    )
  )
  (princ)
)

网友答:
飞雪神光 发表于 2023-12-8 17:16
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=188763&highlight=%B7%D6%D7%E9
http://bbs.mjtd.com/ ...

感谢老铁

下面的程序，来自【世并】

  2. (defun c:tt (/ wkjl ss lst obj maxp minp flst nlst maxpx maxpy pt )
  3.   (IF (NULL *wkjl) (setq *wkjl 30.0))
  4.    (setq wkjl (GETREAL (strcat "\n外扩距离<" (rtos *wkjl 2 2) ">:")))
  5.    (if (NULL wkjl) (setq wkjl *wkjl) (setq *wkjl wkjl))
  6.   
  7.   (setq ss (ssget))
  8.   (setq  lst
  9.    (mapcar '(lambda (x)
  10.         (setq obj (vlax-ename->vla-object x))
  11.         (vla-getboundingbox obj 'minp 'maxp)
  12.         (setq
  13.           maxp (mapcar '* '(1.0 1.0) (vlax-safearray->list maxp))
  14.         )
  15.         (setq
  16.           minp (mapcar '* '(1.0 1.0) (vlax-safearray->list minp))
  17.         )
  18.         (list x (car minp) (car maxp) (cadr minp) (cadr maxp))
  19.       )
  20.      (vl-remove-if-not
  21.        '(lambda (x) (= 'ENAME (type x)))
  22.        (apply 'append (ssnamex ss))
  23.      )
  24.    )
  25.   )
  26.   (setq  flst (lambda (lst key)
  27.          (if lst
  28.      (if key
  29.        (progn
  30.          (setq nlst   (list (list (caar lst)
  31.                (cadddr (car lst))
  32.                (last (car lst))
  33.          ))
  34.          maxpx (caddar lst)
  35.          lst   (cdr lst)
  36.          )
  37.          (while (and lst (<= (cadar lst) maxpx))
  38.            (setq nlst  (cons (list (caar lst)
  39.                  (cadddr (car lst))
  40.                  (last (car lst))
  41.            )
  42.            nlst
  43.            )
  44.            maxpx (max maxpx (caddar lst))
  45.            lst   (cdr lst)
  46.            )
  47.          )
  48.          (cons nlst (flst lst key))
  49.        )
  50.        (progn
  51.          (setq nlst   (list (caar lst))
  52.          maxpy (caddar lst)
  53.          lst   (cdr lst)
  54.          )
  55.          (while (and lst (<= (cadar lst) maxpy))
  56.            (setq nlst  (cons (caar lst) nlst)
  57.            maxpy (max maxpy (caddar lst))
  58.            lst   (cdr lst)
  59.            )
  60.          )
  61.          (cons nlst (flst lst key))
  62.        )
  63.      )
  64.          )
  65.        )
  66.   )
  67.   (setq
  68.     lst
  69.      (apply
  70.        'append
  71.        (mapcar
  72.    '(lambda (wlst)
  73.       (flst (vl-sort wlst '(lambda (a b) (< (cadr a) (cadr b))))
  74.       nil
  75.       )
  76.     )
  77.    (flst (vl-sort lst '(lambda (a b) (< (cadr a) (cadr b)))) t)
  78.        )
  79.      )
  80.   )
  81.   (mapcar
  82.     '(lambda (x)
  83.        (setq pt (apply
  84.    'append
  85.    (mapcar
  86.      '(lambda (ent)
  87.         (vla-getboundingbox (vlax-ename->vla-object ent) 'minp 'maxp)
  88.         (list (mapcar '* '(1.0 1.0) (vlax-safearray->list maxp))
  89.           (mapcar '* '(1.0 1.0) (vlax-safearray->list minp))
  90.         )
  91.       )
  92.      x
  93.    )
  94.        ))
  95.        (setq minp (mapcar '- (apply 'mapcar (cons 'min pt)) (list wkjl wkjl)))
  96.        (setq maxp (mapcar '+ (apply 'mapcar (cons 'max pt)) (list wkjl wkjl)))
  97.        (entmake  (list '(0 . "LWPOLYLINE")
  98.           '(100 . "AcDbEntity")
  99.           '(100 . "AcDbPolyline")
  100.           '(90 . 4)
  101.           '(70 . 1)
  102.           '(62 . 1)
  103.           (cons 10 minp)
  104.           (cons 10 (list (car minp) (cadr maxp)))
  105.           (cons 10 maxp)
  106.           (cons 10 (list (car maxp) (cadr minp)))
  107.     )
  108.        )
  109.      )
  110.     lst
  111.   )
  112.   (princ)
  113. )


可以批量求出最大边界，如果对象obj，包含文字，该怎样修改程序？

网友答: http://bbs.mjtd.com/forum.php?mod=viewthread&tid=188763&highlight=%B7%D6%D7%E9
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=184459&highlight=%B7%D6%B6%D1

多搜搜


网友答:
lengxiaxi 发表于 2023-12-8 19:48
感谢老铁

下面的程序，来自【世并】

嗯 他加了句手输外扩距离 包含文字有什么影响吗 和对象又有什么关系呢


网友答:




网友答:




网友答:
xyp1964 发表于 2023-12-8 21:10

真厉害，感谢分享

网友答:
xyp1964 发表于 2023-12-8 21:10

感谢院长回复，荣幸至极

网友答: 路过，收下各位前辈的代码，感谢有您。
  • 上一篇：(07.07再更新)改进Lee-Mac李麦克大神的outline轮廓边
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025