Topic: CAB,something wrong with "get_group_boundingbox.lsp",please help.

[cjw]

Code: [Select]


;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;       +            get_group_boundingbox.lsp                   +
;;;       +            Created by C. Alan Butler                   +
;;;       +               Copyright 2005                           +
;;;       +   by Precision Drafting & Design All Rights Reserved.  +
;;;       +    Contact at ab2draft@TampaBay.rr.com                 +
;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;
;;; Get a bounding box for a group of bounding boxes
;;; Use the base of the first box as a referance angle that will be
;;; the base angle of the box returned
;;;
;;;   argument 'all; is a list of 4 point lists defining the group of boxes
 (defun get_group_boundingbox (all / ld lb rd rb bd bb td tb tmp refpt angr
                               ang angr s1 s2 pt  anglst intersect dist)

  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  ;; return intersect point between two borders
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  (defun intersect (s1 s2 ang / angr)
    (if (>= ang (* pi 1.5)) ; ANGLE PLUS 90 DEG
      (setq angr (- ang (* pi 1.5))) ; -270 deg
      (setq angr (+ ang (/ pi 2))) ; +90 deg
    )
    (inters s1 (polar s1 angr 10) s2 (polar s2 ang 10) nil)
  ) ; end defun

  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  ;; calc distance & perpenduclar point on border
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  (defun dist (p1 ang p3 p4 / p2 p5 d angp1p5)
    (setq p2 (polar p1 ang 10) ; point on line at angle
          p5 (inters p1 p2 p3 p4 nil) ; perpendicular point
          d  (distance p1 p5)
    )
    ;;  this is needed when angp1p5 is = 2pi
    (if (equal (angle p1 p5) (* 2 pi) 0.00001)
      (setq angp1p5 0.0)
      (setq angp1p5 (angle p1 p5))
    )
    (if (equal angp1p5 ang 0.00001)
      (list (distance p1 p5) p5)
      (list (- (distance p1 p5)) p5)
    )
    ;;  returns (dist point)
  ) ; end defun


   ;;  /*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/
   ;;   start of get_group_boundingbox 
   ;;  \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\
   
  (setq ld    0 ; ld Left Distance : lb Left Broder pt
        rd    0
        td    0
        bd    0
        ;; constant referance point for calcs, it is within the first box
        refpt (polar (caar all) (angle (caar all) (caddar all))
                     (/ (distance (caar all) (caddar all)) 2))
        ang   (angle (caar all) (cadar all)) ; constant angle for calcs
        angr  (if (>= ang (* pi 1.5)) ; ANGLE PLUS 90 DEG
                (- ang (* pi 1.5)) ; -270 deg
                (+ ang (/ pi 2)) ; +90 deg
              )
  )
  ;;  this is needed when ang is = 2pi
  (if (equal ang (* 2 pi) 0.00001)
    (setq ang 0.0)
  )
  ;;  find point on outer most border
  (foreach pt all
    ;; Right Border (ll lr ur ul) -> lr ur -> (cadr pt) (caddr pt)
    (if (>= (car (setq tmp (dist refpt ang (cadr pt) (caddr pt)))) rd)
      (setq rb (cadr tmp) ; new border point
            rd (car tmp) ; new distance
      )
    )
    ;; Left Border (ll lr ur ul) -> ll ul -> (car pt) (cadddr pt)
    (if (<= (car (setq tmp (dist refpt ang (car pt) (cadddr pt)))) ld)
      (setq lb (cadr tmp) ; new border point
            ld (car tmp) ; new distance
      )
    )
    ;; Top Border (ll lr ur ul) -> ur ul -> (cadr pt) (caddr pt)
    (if (>= (car (setq tmp (dist refpt angr (caddr pt) (cadddr pt)))) td)
      (setq tb (cadr tmp) ; new border point
            td (car tmp) ; new distance
      )
    )

    ;; Bottom Border (ll lr ur ul) -> ll lr -> (car pt) (cadddr pt)
    (if (<= (car (setq tmp (dist refpt angr (car pt) (cadr pt)))) bd)
      (setq bb (cadr tmp) ; new border point
            bd (car tmp) ; new distance
      )
    )
  ) ; foreach
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-


  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  ;;      get intersect point between two borders       
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  ;;  Left Border & Bottom Border = Lower left pt
  (list (intersect lb bb ang) ; ll
        (intersect rb bb ang) ; lr
        (intersect rb tb ang) ; ur
        (intersect lb tb ang) ; ul
  )
   ;;  returns (ll lr ur ul)
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-

) ; end defun get_group_boundingbox


Code: [Select]

;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;       +                   box_text                             +
;;;       +            Created by C. Alan Butler                   +
;;;       +               Copyright 2005                           +
;;;       +   by Precision Drafting & Design All Rights Reserved.  +
;;;       +    Contact at ab2draft@TampaBay.rr.com                 +
;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;
;;; VERSION
;;;  1.2 Jan 24, 2006  UCS corrections
;;;  1.3 Nov 26, 2008  Fixed Bug when text was rotated
;;;
;;; FUNCTION
;;;  Return Box coordinates for an dtext object in any UCS, any angle.
;;;
;;; USAGE
;;;  (box_text ent)
;;;
;;; ARGUMENTS
;;;  ent = text ename
;;;
;;;  RETURNS
;;;   list of 4 points for box,  (ll lr ur ul)
;;;
;;; PLATFORMS
;;;  2000+ Tested in 2000 only
;;; FUNCTION
(defun box_dtext (ent / i ename elist lst lst2 tb tb1 tb2 tlen thi ll lr
                  ur ul ang angg UCSang llx lrx urx ulx lly lry ury uly all
                   avg err cntlst
                 )

  (setq UCSang (angle (trans '(0.0 0.0 0.0) 1 0)
                      (trans '(1.0 0.0 0.0) 1 0)
               )
  )
 
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  ;;      get the bounding box   
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
    (setq elist (entget ent)
          ang   (cdr (assoc 50 elist)) ; text angle
          tb    (textbox elist) ; Note that I had some problems with this
          ;tb    (textbox (list (assoc 1 elist) (assoc 40 elist)(assoc 7 elist)));(textbox (list (assoc 1 elist))) ; CAB 11.11.08
          tb1   (car tb)  ; Lower Left Relative to text
          tb2   (cadr tb) ; Upper Right relative to text
          tlen  (- (car tb2) (car tb1))
          thi   (- (cadr tb2) (cadr tb1))
          )
(setq     ang   (- ang UCSang) ; correct for UCS
          ll  (polar (trans (cdr (assoc 10 elist)) 0 1)
                     (+(angle '(0 0) tb1) ang) (DISTANCE '(0 0) tb1)) ; CAB 11.26.2008
          lr    (polar ll ang tlen)
          ur    (polar ll (+ ang (angle tb1 tb2)) (distance tb1 tb2))
          ul    (polar ll (+ ang (/ pi 2)) thi)
    ) ;setq
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
    (list ll lr ur ul)
) ; end defun box_dtext
;;; x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x


Test the drawing with the code.

Code: [Select]

(defun C:TT ()
  (setq BOX_PTS '())
  (setq SS (ssget '((0 . "TEXT"))))
  (repeat (setq I (sslength SS))
    (and (setq E (ssname SS (setq I (1- I))))
(setq BOX (BOX_DTEXT E))
(setq BOX_PTS (cons BOX BOX_PTS))
    )
  )
  (setq 4PTS (GET_GROUP_BOUNDINGBOX BOX_PTS))
)


[CAB]

I'll have some time to look this over this afternoon.

[cjw]

I'll have some time to look this over this afternoon.

Thank you for taking the time to answer.

[Joe Burke]

This may be of interest.

Code: [Select]

;; Argument: a selection set.
;; Returns the bounding box of selection set
;; in WCS coordinates. A two point list,
;; lower left and upper right.
(defun SSBndBox (ss / idx obj lst ptlst)
  (setq idx 0)
  (repeat (sslength ss)
    (setq obj (vlax-ename->vla-object (ssname ss idx))
          lst (cons obj lst)
          idx (1+ idx)
    )
  )
  (foreach x lst
    (vla-getboundingbox x 'mn 'mx)
    (setq ptlst (cons (vlax-safearray->list mn) ptlst))
    (setq ptlst (cons (vlax-safearray->list mx) ptlst))
  )
  ;following by Tony Tanzillo
  (list
    (apply 'mapcar (cons 'min ptlst))
    (apply 'mapcar (cons 'max ptlst))
  )
) ;end


[ElpanovEvgeniy]

acet function:

Code: [Select]

(setq ss  (ssget)
      lst_p '((0 0 0) (1 1 1) (0 1 0))
      e   (car lst)
) ;_  setq
(ACET-ENT-GEOMEXTENTS e)
(ACET-GEOM-EXTENTS e)
(ACET-GEOM-LIST-EXTENTS lst_p)
(ACET-GEOM-SS-EXTENTS ss 1e-3)
(ACET-GEOM-SS-EXTENTS-ACCURATE ss)
(ACET-GEOM-SS-EXTENTS-FAST ss)
(ACET-SS-REMOVE-DUPS-EXTENTS-LIST ss 1e-3)
(ACET-SS-ZOOM-EXTENTS ss)
(ACET-GEOM-SS-EXTENTS ss t)
(ACET-GEOM-MTXTBOX (entget(car(entsel "\nMtext"))) 1e-3)

[Lee Mac]

I wouldn't rely on the ACET functions 

This is what I use...

Code: [Select]

(defun SSBoundingBox ( ss / ent ll ur bBoxs )
  ;; © Lee Mac 2010

  (  (lambda ( i )
       
       (while (setq ent (ssname ss (setq i (1+ i))))
         (vla-getBoundingBox (vlax-ename->vla-object ent) 'll 'ur)

         (setq bBoxs (cons (vlax-safearray->list ur)
                           (cons (vlax-safearray->list ll) bBoxs)))
       )
     )
    -1
  )

  (mapcar
    (function
      (lambda ( operation )
        (apply (function mapcar) (cons operation bBoxs))
      )
    )
    '(min max)
  )
)

[ElpanovEvgeniy]

I wouldn't rely on the ACET functions 

This is what I use...

I think the same way
as an example:
Creat VECTOR_IMAGE

Code: [Select]

(defun lst-getboundingbox (lst / maxp minp)
  (if (and lst (listp lst))
    (apply
      (function
        (lambda (a1 a2 a3 a4 a5 a6)
          (list
            (list
              (apply (function min) a1)
              (apply (function min) a2)
              (apply (function min) a3)
            ) ;_  list
            (list
              (apply (function max) a4)
              (apply (function max) a5)
              (apply (function max) a6)
            ) ;_  list
          ) ;_  list
        ) ;_  lambda
      ) ;_  function
      (apply
        (function mapcar)
        (cons
          'list
          (mapcar
            (function
              (lambda (x)
                (vla-getboundingbox x 'minp 'maxp)
                (append
                  (vlax-safearray->list minp)
                  (vlax-safearray->list maxp)
                ) ;_  list
              ) ;_  lambda
            ) ;_  function
            lst
          ) ;_  mapcar
        ) ;_  cons
      ) ;_  apply
    ) ;_  apply
  ) ;_  if
) ;_  defun

[CAB]

Lot's of good suggestions.
While I check then out here is my revised routine.
Ops, in my clean up I deleted too many ). Revised post.

Code: [Select]

;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;       +            get_group_boundingbox.lsp                   +
;;;       +            Created by C. Alan Butler                   +
;;;       +               Copyright 2005                           +
;;;       +   by Precision Drafting & Design All Rights Reserved.  +
;;;       +    Contact at ab2draft@TampaBay.rr.com                 +
;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;
;;;   -=<  Revised 10/13/2010  >=-
;;;     Bug Fix - when one text box is not aligned with the others
;;;
;;; Get a bounding box for a group of bounding boxes
;;; Use the base of the first box as a referance angle that will be
;;; the base angle of the box returned
;;;
;;;   argument 'all; is a list of 4 point lists defining the group of boxes
 (defun get_group_boundingbox (all / ld lb rd rb bd bb td tb tmp refpt angr
                               ang angr s1 s2 pt  anglst intersect dist)

  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  ;; return intersect point between two borders
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  (defun intersect (s1 s2 ang / angr)
    (if (>= ang (* pi 1.5)) ; ANGLE PLUS 90 DEG
      (setq angr (- ang (* pi 1.5))) ; -270 deg
      (setq angr (+ ang (/ pi 2))) ; +90 deg
    )
    (inters s1 (polar s1 angr 10) s2 (polar s2 ang 10) nil)
  ) ; end defun

  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  ;; calc distance & perpenduclar point on border
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
(defun dist (p1                         ;  constant referance point
             ang                        ; Angle Allowed +/-
             4pts
             /
             p3 p4 p5 lst
             dst  ; used to prevent conditions when the box is off angle and
             ;;   inters returns a crossing point at a great distance
             )
  (setq 4pts (append box (list (car 4pts)))
        dst  (apply (function max) (mapcar(function(lambda(x) (distance p1 x))) 4pts))
        p2   (polar p1 ang 10)
  )
 
  (while (cadr 4pts) ; check all sides
    (setq p3 (car 4pts)
          p4 (cadr 4pts)
    )
    (setq 4pts (cdr 4pts)
          p5   (inters p1 p2 p3 p4 nil)
    )                                   ; perpendicular point
    (if (and p5 (equal ang (NormAng (angle p1 p5)) 0.0001))
      (progn
        (if (and (< (distance p1 p5) dst)
                 (or (null lst)
                     (> (distance p1 p5)(distance p1 (caddr lst))))
            )
          (setq lst (list p3 p4 p5))
        )
    )
      )
  )
 
  (if lst
    (list (abs (distance p1 (last lst))) (list (car lst) (cadr lst))) ;  returns
  )
)                                       ; end defun


   ;; correct for > 2pi
   (defun NormAng (a)
     (if (>= a (- (* 2 pi) 0.00001))
       (- a (* 2 pi))
       a
     )
   )
   (defun AddAngles (a1 a2 / tmp)
     (if (>= (setq tmp (+ a1 a2)) (- (* 2 pi) 0.00001))
       (- tmp (* 2 pi))
       tmp
     )       
   )

   
   ;;  /*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/
   ;;   start of get_group_boundingbox 
   ;;  \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\
   
  (setq ld    0 ; ld Left Distance : lb Left Broder pt
        rd    0
        td    0
        bd    0
        ;; constant referance point for calcs, it is within the first box
        ;;  note that this may be anywhere within the group of boxes
        refpt (polar (caar all) (angle (caar all) (caddar all))
                     (/ (distance (caar all) (caddar all)) 2))
       
        ang   (angle (caar all) (cadar all)) ; constant angle for calcs
        angr  (if (>= ang (* pi 1.5)) ; ANGLE PLUS 90 DEG
                (- ang (* pi 1.5)) ; -270 deg
                (+ ang (/ pi 2)) ; +90 deg
              )
  )
  ;;  this is needed when ang is = 2pi
  (if (equal ang (* 2 pi) 0.00001)
    (setq ang 0.0)
  )
  ;;  Check each text box and find find point on outer most border
  (foreach box all
   
    ;; Right Border (ll lr ur ul) -> lr ur -> (cadr box) (caddr box)
    (if (and (setq tmp (dist refpt ang box))
             (or (>= (car tmp) rd) (null rb)))
      (setq rb (cadr tmp) ; new border points
            rd (car tmp) ; new distance
      )
    )
   
    ;; Left Border (ll lr ur ul) -> ll ul -> (car box) (cadddr box)
    (if (and (setq tmp (dist refpt (AddAngles ang pi) box))
             (or (>= (car tmp) ld) (null lb)))
      (setq lb (cadr tmp) ; new border points
            ld (car tmp) ; new distance
      )
    )
   
    ;; Top Border (ll lr ur ul) -> ur ul -> (cadr box) (caddr box)
    (if (and (setq tmp (dist refpt (AddAngles ang (* 0.5 pi)) box))
             (or(>= (car tmp) td) (null tb)))
      (setq tb (cadr tmp) ; new border points
            td (car tmp) ; new distance
      )
    )
   
    ;; Bottom Border (ll lr ur ul) -> ll lr -> (car box) (cadddr box)
    (if (and (setq tmp (dist refpt (AddAngles ang (* 1.5 pi)) box))
             (or(>= (car tmp) bd) (null bb)))
      (setq bb (cadr tmp) ; new border points
            bd (car tmp) ; new distance
      )
    )
   
  ) ; foreach
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-


  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  ;;      get intersect point between two borders       
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
   (list
     (inters (car lb)(cadr lb)(car bb)(cadr bb) nil)
     (inters (car rb)(cadr rb)(car bb)(cadr bb) nil)
     (inters (car rb)(cadr rb)(car tb)(cadr tb) nil)
     (inters (car lb)(cadr lb)(car tb)(cadr tb) nil)
   )
   ;;  returns (ll lr ur ul)
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-

) ; end defun get_group_boundingbox

[CAB]

FYI, this is the desired result using plain text.

[Joe Burke]

Maybe I'm missing something?

I thought the desired result is the minimum bounding box (lower left and upper right points) which encloses the bounding boxes of all the seleted objects.

[CAB]

Yes, the bounding box of the smaller boxes BUT not WCS but rotated to match the rotation of the first bounding box supplied in the list of smaller bounding boxes.
If I am being clear?

The box_dtext.lsp returns a bounding box of plain text which matches it's angle.
So you feed it the ename of the text one by one to get your list of 4 point list.
Then you feet that list to get_group_boundingbox.lsp which returns the box for the group of boxes. All
based on the angle of the first 4 point list in the master list.

[CAB]

See this rotated view.

Give this lisp a try. http://www.theswamp.org/index.php?topic=7003.0


<edit: file deleted and link added as you need the zip file to get all you need.>

[cjw]

Yes, the bounding box of the smaller boxes BUT not WCS but rotated to match the rotation of the first bounding box supplied in the list of smaller bounding boxes.
If I am being clear?

The box_dtext.lsp returns a bounding box of plain text which matches it's angle.
So you feed it the ename of the text one by one to get your list of 4 point list.
Then you feet that list to get_group_boundingbox.lsp which returns the box for the group of boxes. All
based on the angle of the first 4 point list in the master list.

So hard.
Thank you verrrry much.
CAB,you are great.

[cjw]

And thank you all.
You are all nice guys.

[Joe Burke]

Yes, the bounding box of the smaller boxes BUT not WCS but rotated to match the rotation of the first bounding box supplied in the list of smaller bounding boxes.
If I am being clear?

The box_dtext.lsp returns a bounding box of plain text which matches it's angle.
So you feed it the ename of the text one by one to get your list of 4 point list.
Then you feet that list to get_group_boundingbox.lsp which returns the box for the group of boxes. All
based on the angle of the first 4 point list in the master list.

I get it now. Thanks for clarification.