批量执行的边界盒，有可能实现吗？

lengxiaxi

引用一段源码，来自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. )

;【PF工具箱--自动边界盒】<br /> (defun c:bjh (/ ss i l1 l2 ll ur os d)<br />    (setq os (getvar 'osmode))<br />    (PRINC "\n【PF工具箱--QQ交流群：214654218】--自动边界盒 ")(PRINC)  <br />    (setq d (getreal "\n偏距<5>"))<br />    (if (null d)<br />      (setq d 5)<br />    )<br />    (setq ss (ssget))<br />    (repeat (setq i (sslength ss))<br />      (vla-getboundingbox<br />        (vlax-ename->vla-object (ssname ss (setq i (1- i))))<br />        'll<br />        'ur<br />      )<br />      (setq l1 (cons (vlax-safearray->list ll) l1)<br />            l2 (cons (vlax-safearray->list ur) l2)<br />      )<br />    )<br />    (mapcar 'set<br />            (list 'll 'ur)<br />            (mapcar '(lambda (a b) (apply 'mapcar (cons a b)))<br />                    '(min max)<br />                    (list l1 l2)<br />            )<br />    )<br />    (command<br />      "rectang"<br />      (trans (polar ll (* pi 1.25) (setq d (sqrt (+ (* d d) (* d d)))))<br />             0<br />             1<br />      )<br />      (trans (polar ur (* pi 0.25) d) 0 1)<br />    )<br />    (setvar 'osmode os)<br />    (princ)<br /> )

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

yoyoho

;;框选物体画框 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)
)

lengxiaxi

飞雪神光 发表于 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. )

(defun c:tt (/ wkjl ss lst obj maxp minp flst nlst maxpx maxpy pt )<br />   (IF (NULL *wkjl) (setq *wkjl 30.0))<br />    (setq wkjl (GETREAL (strcat "\n外扩距离<" (rtos *wkjl 2 2) ">:")))<br />    (if (NULL wkjl) (setq wkjl *wkjl) (setq *wkjl wkjl))<br />   <br />   (setq ss (ssget))<br />   (setq  lst<br />    (mapcar '(lambda (x)<br />         (setq obj (vlax-ename->vla-object x))<br />         (vla-getboundingbox obj 'minp 'maxp)<br />         (setq<br />           maxp (mapcar '* '(1.0 1.0) (vlax-safearray->list maxp))<br />         )<br />         (setq<br />           minp (mapcar '* '(1.0 1.0) (vlax-safearray->list minp))<br />         )<br />         (list x (car minp) (car maxp) (cadr minp) (cadr maxp))<br />       )<br />      (vl-remove-if-not<br />        '(lambda (x) (= 'ENAME (type x)))<br />        (apply 'append (ssnamex ss))<br />      )<br />    )<br />   )<br />   (setq  flst (lambda (lst key)<br />          (if lst<br />      (if key<br />        (progn<br />          (setq nlst   (list (list (caar lst)<br />                (cadddr (car lst))<br />                (last (car lst))<br />          ))<br />          maxpx (caddar lst)<br />          lst   (cdr lst)<br />          )<br />          (while (and lst (<= (cadar lst) maxpx))<br />            (setq nlst  (cons (list (caar lst)<br />                  (cadddr (car lst))<br />                  (last (car lst))<br />            )<br />            nlst<br />            )<br />            maxpx (max maxpx (caddar lst))<br />            lst   (cdr lst)<br />            )<br />          )<br />          (cons nlst (flst lst key))<br />        )<br />        (progn<br />          (setq nlst   (list (caar lst))<br />          maxpy (caddar lst)<br />          lst   (cdr lst)<br />          )<br />          (while (and lst (<= (cadar lst) maxpy))<br />            (setq nlst  (cons (caar lst) nlst)<br />            maxpy (max maxpy (caddar lst))<br />            lst   (cdr lst)<br />            )<br />          )<br />          (cons nlst (flst lst key))<br />        )<br />      )<br />          )<br />        )<br />   )<br />   (setq<br />     lst<br />      (apply<br />        'append<br />        (mapcar<br />    '(lambda (wlst)<br />       (flst (vl-sort wlst '(lambda (a b) (< (cadr a) (cadr b))))<br />       nil<br />       )<br />     )<br />    (flst (vl-sort lst '(lambda (a b) (< (cadr a) (cadr b)))) t)<br />        )<br />      )<br />   )<br />   (mapcar<br />     '(lambda (x)<br />        (setq pt (apply<br />    'append<br />    (mapcar<br />      '(lambda (ent)<br />         (vla-getboundingbox (vlax-ename->vla-object ent) 'minp 'maxp)<br />         (list (mapcar '* '(1.0 1.0) (vlax-safearray->list maxp))<br />           (mapcar '* '(1.0 1.0) (vlax-safearray->list minp))<br />         )<br />       )<br />      x<br />    )<br />        ))<br />        (setq minp (mapcar '- (apply 'mapcar (cons 'min pt)) (list wkjl wkjl)))<br />        (setq maxp (mapcar '+ (apply 'mapcar (cons 'max pt)) (list wkjl wkjl)))<br />        (entmake  (list '(0 . "LWPOLYLINE")<br />           '(100 . "AcDbEntity")<br />           '(100 . "AcDbPolyline")<br />           '(90 . 4)<br />           '(70 . 1)<br />           '(62 . 1)<br />           (cons 10 minp)<br />           (cons 10 (list (car minp) (cadr maxp)))<br />           (cons 10 maxp)<br />           (cons 10 (list (car maxp) (cadr minp)))<br />     )<br />        )<br />      )<br />     lst<br />   )<br />   (princ)<br /> )

可以批量求出最大边界，如果对象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

xyp1964

paulpipi

xyp1964 发表于 2023-12-8 21:10

真厉害，感谢分享

lengxiaxi

xyp1964 发表于 2023-12-8 21:10

感谢院长回复，荣幸至极

jkop

路过，收下各位前辈的代码，感谢有您。