How to find the center (via bounding box) of selected objects

[Anonymous]

Hi,

My problem is this:  When I select a several objects, I want to be able to select the center of the already selected objects using a keyword (lets call it "GetCenter" for example).  I would want the middle of the group's bounding box because I want it to work consistently with any mixed objects.

It would be similar to M2P, but without having to click two points.  That way I can include it in several of my keyboard macros.  

For example, I would like to have macros to scale selected objects up or down by 10%.  So my macro would look like "Scale GetCenter 1.1" assuming I have the objects selected ahead of time, or "^C^CScale p  GetCenter 1.1" if I have a previous selection set defined and I want to be able to repeat it.

A variation would be to use it inside another command, similar to M2P but by selecting objects on-screen. 

I have tried to search for an answer on this forum and on Google but I cannot quite find it.  Of course a complete AutoLisp program would be sweet!!  I have very limited experience in AutoLisp but I will also gladly accept a push in the right direction;)

Cheers!

[ВeekeeCZ]

Try Lee's functions HERE

[john.uhden]

I've never played with regions before, so I thought this would be fun.  It was odd to me that you can union regions that don't even overlap.

I'm guessing that the UCS has to be World.

(defun bbcentroid ( / Doc Model ss1 ss2 i LL UR Box e p)
  (setq Doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq Model (vla-get-modelspace Doc))
  (and
    (setq ss1 (ssget) ss2 (ssadd))
    (repeat (setq i (sslength ss1))
      (vla-getboundingbox (vlax-ename->vla-object (ssname ss1 (setq i (1- i)))) 'LL 'UR)
      (setq LL (vlax-safearray->list LL) UR (vlax-safearray->list UR))
      (setq Box (apply 'append (list (list (car LL)(cadr LL)) (list (car UR)(cadr LL))(list (car UR)(cadr UR)) (list (car LL)(cadr UR)))))
      (setq obj (vlax-invoke Model 'addlightweightpolyline Box))
      (vlax-put Obj 'Closed 1)
      (setq ss2 (ssadd (vlax-vla-object->ename obj) ss2))
    )
    (setq e (entlast))
    (vl-cmdf "_.region" ss2 "")
    (setq ss2 (ssadd))
    (while (setq e (entnext e))(ssadd e ss2))
    (vl-cmdf "_.union" ss2 "")
    (setq p (vlax-get (vlax-ename->vla-object (entlast)) 'centroid))
    (entdel (entlast))
    (entmakex (list '(0 . "POINT")(cons 10 p)))
  )
  p
)

[Anonymous]

Thanks John, that was a quick reply!  Almost there...

Any way to modify the command so that I can use it in-line with other commands?  For example, if I start a polyline and I want one point to hit the BBCENTROID.  Similar to using the 'M2P' command.

I see that you are using the centroids of the objects but what about just the bounding box of the entire selection set?

FYI, I just made a VBA routine to store the center of the ThisDrawing.PickfirstSelectionSet's bounding box into 'USERS4'.  

Public Sub SetLastBoundingBoxCenter()
  Static i As Integer, MinPt As Variant, MaxPt As Variant, MinPti As Variant, MaxPti As Variant
  If ThisDrawing.PickfirstSelectionSet.Count = 0 Then Exit Sub
  ThisDrawing.PickfirstSelectionSet(0).GetBoundingBox MinPt, MaxPt
  MinPti = MinPt: MaxPti = MaxPt
  For i = 1 To ThisDrawing.PickfirstSelectionSet.Count - 1
    ThisDrawing.PickfirstSelectionSet(i).GetBoundingBox MinPti, MaxPti
    MinPt(0) = Min(MinPt(0), MinPti(0))
    MinPt(1) = Min(MinPt(1), MinPti(1))
    MinPt(2) = Min(MinPt(2), MinPti(2))
    MaxPt(0) = Max(MaxPt(0), MaxPti(0))
    MaxPt(1) = Max(MaxPt(1), MaxPti(1))
    MaxPt(2) = Max(MaxPt(2), MaxPti(2))
  Next
  ThisDrawing.SetVariable "USERS4", CStr((MaxPt(0) + MinPt(0)) / 2) + "," + CStr((MaxPt(1) + MinPt(1)) / 2) + "," + CStr((MaxPt(2) + MinPt(2)) / 2)
End Sub

I just happen to be using USERS5 for another function and decided to arbitrarily use USERS4.  Max and Min functions are my own brew.

Then I put a hook in the SelectionChanged event:

Private Sub AcadDocument_SelectionChanged()
  If ThisDrawing.PickfirstSelectionSet.Count <= 100 Then Call SetLastBoundingBoxCenter
End Sub

I limited the amount of selected items to 100 in case the subroutine gets bogged down.

Then I make a simple AutoLisp command that I can use anywhere I like:

(defun BBC() (getvar "USERS4"))

The problem with this method is that every single time I make a selection, the subroutine runs and slows down my system.  It doesn't seem very much but it certainly is not an elegant solution.  I'd rather use a complete AutoList program and use it only on-demand.

I would also like to access the BBC value without using the parentheses (similar to using the M2P command).  Any thoughts on that?

Cheers!

[Anonymous]

Hi BeekeeCZ,

Thanks for the direction, I think I can add the simple functions to get the centre of the boundingbox.

Any idea how I can alter the function so that I can use it in-line with, lets say, a polyline command?  Or any command where I need to supply a point?

Cheers!

[Kent1Cooper]

This is how I've gotten the bounding box of a selection-set's-worth of objects [from a different routine], with 'sset' being the selection set:

  (setq
    sset (ssget)

    ssLL (getvar 'extmax); initially
    ssUR (getvar 'extmin)
  ); setq

  (repeat (sslength sset)
    (setq obj (vlax-ename->vla-object (ssname sset 0)))
    (vla-getboundingbox obj 'minpt 'maxpt)
    (setq
      objLL (vlax-safearray->list minpt)
      objUR (vlax-safearray->list maxpt)
      ssLL (mapcar 'min ssLL objLL)
      ssUR (mapcar 'max ssUR objUR)
    ); setq
    (ssdel (ssname sset 0) sset)
  ); repeat

The other routine Zooms to the collective bounding box, using the ssLL and ssUR locations for the Zoom window.  In this case, the midpoint of that collective bounding box can be gotten easily, this way:

(mapcar '/ (mapcar '+ ssLL ssUR) '(2 2 2))

What I'm having trouble with is getting it to use a pre-selection if there is one -- e.g. (setq sset (ssget "_I")) -- but ask the User to select if there isn't, and then in either case calculate the middle and feed that to a command in progress.  If I call up a Line command, for instance, the pre-selection disappears, so code like this can't make use of it, though I have gotten it to take an in-progress User selection.  If I work it out, I'll be back, but anyone else can try, if these parts look usable.

[Anonymous]

Hi BeeKeeCZ,

Sorry, I got really interested in this and finished it.  Here is my simple function based on Lee's function that you linked:

(defun bbc (/ sel idx llp ls1 ls2 obj urp )
    (setq sel (ssget "P"))
    (repeat (setq idx (sslength sel))
        (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
        (if (and (vlax-method-applicable-p obj 'getboundingbox)
                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
            )
            (setq ls1 (mapcar 'min (vlax-safearray->list llp) (cond (ls1) ((vlax-safearray->list llp))))
                  ls2 (mapcar 'max (vlax-safearray->list urp) (cond (ls2) ((vlax-safearray->list urp))))
            )
        )
    )
    (if (and ls1 ls2) (list (/ (+ (nth 0 ls1) (nth 0 ls2)) 2) (/ (+ (nth 1 ls1) (nth 1 ls2)) 2) (/ (+ (nth 2 ls1) (nth 2 ls2)) 2)  ))
)

Now if I have objects previously selected it will automatically find the centre of the bounding box and I can use it in-line with other commands.  If I want a function that will ask me for a selection all I need to do is get rid of the "P" in the (ssget "P") command.  I can make two commands to handle both cases 'BBC' and 'BBCP'.  🙂

Thanks for your help!

For extra kudos, is there a way to use the command without the parenthesis?  Like using the M2P command?

[ВeekeeCZ · Accepted solution]

Try this mod.

;; Selection Set Bounding Box  -  Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; sel - [sel] Selection set for which to return bounding box

(defun c:ssc ( / idx llp ls1 ls2 obj urp lst)
  (setq sel (ssget "_P"))
  (repeat (setq idx (sslength sel))
    (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
    (if (and (vlax-method-applicable-p obj 'getboundingbox)
	     (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
	     )
      (setq ls1 (cons (vlax-safearray->list llp) ls1)
	    ls2 (cons (vlax-safearray->list urp) ls2))))
  (if (and ls1
	   ls2
	   (setq lst (mapcar '(lambda (a b) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))))
    (trans (mapcar '(lambda (a b) (/ (+ a b) 2.)) (car lst) (last lst)) 0 1)))

Then usage is like any tranparent command 'ssc. Previous selection is stored automatically within the code.

Edit: Well, you've got most of it by yourself seconds before me, just add c: and you're done!

Edit2: Added trans WCS -> UCS.

[john.uhden]

This one does not use any commands (region or union) to get the centroid.  We can't use those commands within another active command.  It just takes the center (average) of the extreme Xs and Ys.

You can use it transparently within an AutoCAD command, but not an AutoLisp command, as in:

Command: Line 'BBC

(defun c:bbc ( / ss i LL UR bounds xmin ymin xmax ymax p)
  (and
    (setq ss (ssget))
    (repeat (setq i (sslength ss))
      (vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'LL 'UR)
      (setq LL (vlax-safearray->list LL) UR (vlax-safearray->list UR))
      (setq bounds (cons LL (cons UR bounds)))
    )
    (setq xmin (apply 'min (mapcar 'car bounds))
               ymin (apply 'min (mapcar 'cadr bounds))
               xmax (apply 'max (mapcar 'car bounds))
               ymax (apply 'max (mapcar 'cadr bounds))
    )
    (setq p (mapcar '* '(0.5 0.5)(list (+ xmin xmax)(+ ymin ymax))))
    ;; (entmakex (list '(0 . "POINT")(cons 10 p)))
  )
  p
)

I trust there is no copyright or trademark infringement on British broadcasting.

[john.uhden]

Also note that the return is a 2D point, no Zs.