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

lengxiaxi 发表于 2023-12-8 16:14:07

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

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

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

yoyoho 发表于 2023-12-8 20:09:31

本帖最后由 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) (* -1DIST2)))
   ;(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 19:48:00

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

感谢老铁

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

(defun c:tt (/ wkjl ss lst obj maxp minp flst nlst maxpx maxpy pt )
(IF (NULL *wkjl) (setq *wkjl 30.0))
(setq wkjl (GETREAL (strcat "\n外扩距离<" (rtos *wkjl 2 2) ">:")))
(if (NULL wkjl) (setq wkjl *wkjl) (setq *wkjl wkjl))

(setq ss (ssget))
(setqlst
(mapcar '(lambda (x)
   (setq obj (vlax-ename->vla-object x))
   (vla-getboundingbox obj 'minp 'maxp)
   (setq
      maxp (mapcar '* '(1.0 1.0) (vlax-safearray->list maxp))
   )
   (setq
      minp (mapcar '* '(1.0 1.0) (vlax-safearray->list minp))
   )
   (list x (car minp) (car maxp) (cadr minp) (cadr maxp))
   )
(vl-remove-if-not
   '(lambda (x) (= 'ENAME (type x)))
   (apply 'append (ssnamex ss))
)
)
)
(setqflst (lambda (lst key)
      (if lst
(if key
   (progn
      (setq nlst (list (list (caar lst)
            (cadddr (car lst))
            (last (car lst))
      ))
      maxpx (caddar lst)
      lst (cdr lst)
      )
      (while (and lst (<= (cadar lst) maxpx))
      (setq nlst(cons (list (caar lst)
            (cadddr (car lst))
            (last (car lst))
      )
      nlst
      )
      maxpx (max maxpx (caddar lst))
      lst (cdr lst)
      )
      )
      (cons nlst (flst lst key))
   )
   (progn
      (setq nlst (list (caar lst))
      maxpy (caddar lst)
      lst (cdr lst)
      )
      (while (and lst (<= (cadar lst) maxpy))
      (setq nlst(cons (caar lst) nlst)
      maxpy (max maxpy (caddar lst))
      lst (cdr lst)
      )
      )
      (cons nlst (flst lst key))
   )
)
      )
   )
)
(setq
lst
(apply
   'append
   (mapcar
'(lambda (wlst)
   (flst (vl-sort wlst '(lambda (a b) (< (cadr a) (cadr b))))
   nil
   )
)
(flst (vl-sort lst '(lambda (a b) (< (cadr a) (cadr b)))) t)
   )
)
)
(mapcar
'(lambda (x)
   (setq pt (apply
'append
(mapcar
'(lambda (ent)
   (vla-getboundingbox (vlax-ename->vla-object ent) 'minp 'maxp)
   (list (mapcar '* '(1.0 1.0) (vlax-safearray->list maxp))
      (mapcar '* '(1.0 1.0) (vlax-safearray->list minp))
   )
   )
x
)
   ))
   (setq minp (mapcar '- (apply 'mapcar (cons 'min pt)) (list wkjl wkjl)))
   (setq maxp (mapcar '+ (apply 'mapcar (cons 'max pt)) (list wkjl wkjl)))
   (entmake(list '(0 . "LWPOLYLINE")
      '(100 . "AcDbEntity")
      '(100 . "AcDbPolyline")
      '(90 . 4)
      '(70 . 1)
      '(62 . 1)
      (cons 10 minp)
      (cons 10 (list (car minp) (cadr maxp)))
      (cons 10 maxp)
      (cons 10 (list (car maxp) (cadr minp)))
)
   )
)
lst
)
(princ)
)

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

飞雪神光 发表于 2023-12-8 17:16:25

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

多搜搜

飞雪神光 发表于 2023-12-8 19:56:50

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

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

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

xyp1964 发表于 2023-12-8 21:03:55

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

paulpipi 发表于 2023-12-8 23:19:22

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

真厉害，感谢分享

lengxiaxi 发表于 2023-12-9 08:02:50

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

感谢院长回复，荣幸至极

jkop 发表于 2023-12-9 18:02:56

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

页: [1] 2

明经CAD社区's Archiver

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