Topic: Selection Set Center

[Ron Heigh]

Is there any way to get the center of a selection set of entities?
(lines, text, plines, blocks)

[Jeff_M]

Is there any way to get the center of a selection set of entities?
(lines, text, plines, blocks)

Yes, there is.
Here is a routine that uses the bounding box of the Selection Set to zoom to the SS. You can take out the part that gets the BB and use it to determine the center fairly easily.
Good Luck!

Code: [Select]


(defun c:zss (/ count ent ll ll-ent ll-ss ur
     ur-ent ur-ss llx lly urx ury)
  (if (or (setq zz_ss (cadr (ssgetfirst)))
 (setq zz_ss (ssget)))
    (progn
      (setq count -1)
      (while (< (setq count (1+ count))(sslength zz_ss))
(setq ent (vlax-ename->vla-object (ssname zz_ss count)))
(vla-getboundingbox ent 'll 'ur)
(vla-highlight ent :vlax-true)
(setq ll-ent (vlax-safearray->list ll)
     ur-ent (vlax-safearray->list ur))
(if (not ll-ss)
 (setq ll-ss ll-ent
ur-ss ur-ent)
 (progn
   (if (< (car ll-ent)(car ll-ss))
     (if (< (cadr ll-ent)(cadr ll-ss))
(setq ll-ss ll-ent)
(setq ll-ss (list (car ll-ent)
 (cadr ll-ss))
     )
)
     (if (< (cadr ll-ent)(cadr ll-ss))
(setq ll-ss (list (car ll-ss)
 (cadr ll-ent))
     )
)
     )
   (if (> (car ur-ent)(car ur-ss))
     (if (> (cadr ur-ent)(cadr ur-ss))
(setq ur-ss ur-ent)
(setq ur-ss (list (car ur-ent)
 (cadr ur-ss))
     )
)
     (if (> (cadr ur-ent)(cadr ur-ss))
(setq ur-ss (list (car ur-ss)
 (cadr ur-ent))
     )
);if
     );if
   );progn
 );if
);while
      (setq ll (vlax-3d-point ll-ss)
   ur (vlax-3d-point ur-ss)
   llx (car ll-ss)
   lly (cadr ll-ss)
   urx (car ur-ss)
   ury (cadr ur-ss)
   );setq
      (vla-zoomwindow (vlax-get-acad-object) ll ur)
      (vla-zoomscaled (vlax-get-acad-object) 0.9 acZoomScaledRelative)
      (grvecs (list -7
   (list llx lly)(list llx ury)
   (list llx ury)(list urx ury)
   (list urx ury)(list urx lly)
   (list urx lly)(list llx lly)
   )
     )
      );progn
    );if
  (princ)
  );defun


ps, this was written in my early learning days of lisp/vlisp/activex, so it is probably not very efficient. But, it does work.......

[daron]

It looks decent Jeff. Only thing I'd do is remove the C: and make the defun name more meaninful so it can be used and remembered what it's for when updating main functions that should be calling it.

[Ron Heigh]

Thanks for your contribution guys.
This should do the trick nicely.

[CAB]

Jeff,
Look what I have in my "borrowed" Folder
Is this an old version?

Code: [Select]

;| Routine to create a selection set and zoom to the extents of the ss.
Jeff Mishler Jun 2003
|;

(defun zss (/ count ent ll ll-ent ll-ss ss ur ur-ent ur-ss llx lly urx
            ury)
  (if (setq ss (ssget))
    (progn
      (setq count -1)
      (while (< (setq count (1+ count)) (sslength ss))
        (setq ent (vlax-ename->vla-object (ssname ss count)))
        (vla-getboundingbox ent 'll 'ur)
        (setq ll-ent (vlax-safearray->list ll)
              ur-ent (vlax-safearray->list ur)
        )
        (if (not ll-ss)
          (setq ll-ss ll-ent
                ur-ss ur-ent
          )
          (progn
            (if (< (car ll-ent) (car ll-ss))
              (if (< (cadr ll-ent) (cadr ll-ss))
                (setq ll-ss ll-ent)
                (setq ll-ss (list (car ll-ent)
                                  (cadr ll-ss)
                            )
                )
              )
              (if (< (cadr ll-ent) (cadr ll-ss))
                (setq ll-ss (list (car ll-ss)
                                  (cadr ll-ent)
                            )
                )
              )
            )
            (if (> (car ur-ent) (car ur-ss))
              (if (> (cadr ur-ent) (cadr ur-ss))
                (setq ur-ss ur-ent)
                (setq ur-ss (list (car ur-ent)
                                  (cadr ur-ss)
                            )
                )
              )
              (if (> (cadr ur-ent) (cadr ur-ss))
                (setq ur-ss (list (car ur-ss)
                                  (cadr ur-ent)
                            )
                )
              ) ;if
            ) ;if
          ) ;progn
        ) ;if
      ) ;while
      (setq ll  (vlax-3d-point ll-ss)
            ur  (vlax-3d-point ur-ss)
            llx (car ll-ss)
            lly (cadr ll-ss)
            urx (car ur-ss)
            ury (cadr ur-ss)
      ) ;setq
      (vla-zoomwindow (vlax-get-acad-object) ll ur)
      (grvecs (list -1
                    (list llx lly) (list llx ury)
                    (list llx ury) (list urx ury)
                    (list urx ury) (list urx lly)
                    (list urx lly) (list llx lly)
              )
      )
    ) ;progn
  ) ;if
  (princ)
) ;defun


(defun c:zsscall()
  (zss)
  )

[Jeff_M]

CAB,
Nope, I think you'll find them both to be the same.  I wrote that for a specific job last year that was extemely "busy" so was difficult to see what was selected. I don't think I've used it since.......

It's good to know that at least 1 other user found it somewhat useful  

[CAB]

Thanks Jeff,

I have enjoyed all you contributions.

CAB