Jump to content

Need Help With Bounding Box Move LISP! HELP!


tmelancon
 Share

Recommended Posts

I currently have a really really basic LISP routine. It was written to center a group of objects within a 12x9 drawing sheet (some people do not care whether their drawing is centered or not... pet peeve) ANYWAYS..

 

In a nutshell it prompts user to select objects using SSGET. Then asks the user for 2 points, which could be any two opposing points that encompass the outer most limits of the group of objects. After the SSGET and the 2 points have been established I have the routine moving the group based on center of 2 points to the center of the 12x9 drawing sheet.

 

We draw in isometric hence the command snap "I" and "S". I had it snap to Standard so the beginner users can quickly move their cursor to the extents of any given group.. See Code below

 

(DEFUN C:CEN (/ *ERROR* oldsnap oldos)
 (defun *error* (msg)
   (if oldos (setvar "osmode" oldos))
   (if oldsnap (setvar "snapmode" oldsnap))
   (if msg (prompt msg))
   (princ)
 )
(setvar "cmdecho" 0)
(setq oldsnap (getvar "snapmode")
(setq oldos (getvar "osmode"))
(princ "\nSelect Object(s) to CENTER within the titleblock. ")
(SETQ CENT3R (SSGET ))
(command "snap" "s" "s" "")
(setvar "snapmode" 0)
(SETQ P1 (GETpoint "\nFirst corner of rectangle: "))
(setvar "osmode" 0)
(setq p2 (getCORNER P1 "\nSecond corner of rectangle: "))
(COMMAND "MOVE" CENT3R "" "m2p" p1 p2 "M2P" "0,0" "12,9")
(command "snap" "s" "i" "")
(setvar "snapmode" oldsnap)
(setvar "OSMODE" OLDOS)
(SETQ CENT3R NIL)
(*ERROR* NIL)
(PRINT)
)

 

I would like to use BoundingBox function to Automatically get the coordinates of the SSGET, instead of asking user for First and Second points of rectangle. See Code below that gets bounding box coordinates. Can someone please help me bring these 2 together? Thanks and God bless.

 

(defun c:test ( / OBJ Point1 Point2 ) 
(vl-load-com) 
(princ "\nSelect an object: ") 
(setq OBJ (vlax-ename->vla-object (ssname (ssget) 0))) 
(if OBJ 
(progn 
;;OBJ is a vla-object 
;;Point1 is the lower left point of the bounding box around the object 
;;Point2 is the upper right point of the bounding box around the object 
(vla-getboundingbox OBJ 'Point1 'Point2) 
;;Point1 and Point2 are returned as a safearray and need to be converted to a list 
(setq Point1 (vlax-safearray->list Point1)) 
(setq Point2 (vlax-safearray->list Point2)) 
(princ (strcat "\n The lower left corner is " (rtos (car Point1) 2 2) ", " (rtos (cadr Point1) 2 2))) 
(princ (strcat "\nThe upper right corner is " (rtos (car Point2) 2 2) ", " (rtos (cadr Point2) 2 2))) 
) 
) 
(princ) )

Link to comment
Share on other sites

Here's a quick draft using my Selection Set Bounding Box function:

(defun c:cen ( / s l )
   (and (setq s (ssget "_:L"))
        (setq l (LM:ssboundingbox s))
        (command "_.move" s ""
            "_non"  (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) l))
            "_non" '(6.0 4.5)
        )
   )
   (princ)
)

;; 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.
;; s - [sel] Selection set for which to return bounding box

(defun LM:ssboundingbox ( s / a b i m n o )
   (repeat (setq i (sslength s))
       (if
           (and
               (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
               (vlax-method-applicable-p o 'getboundingbox)
               (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
           )
           (setq m (cons (vlax-safearray->list a) m)
                 n (cons (vlax-safearray->list b) n)
           )
       )
   )
   (if (and m n)
       (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
   )
)

(vl-load-com) (princ)

Link to comment
Share on other sites

Mr Lee Mac, again you have delivered! I cannot thank you enough for your continued hard work and dedication to helping those, and myself, in the CAD TUTOR community! Your routine worked flawlessly! I wish you and your family well! :notworthy::notworthy::notworthy::D

Link to comment
Share on other sites

Mr Lee Mac, again you have delivered! I cannot thank you enough for your continued hard work and dedication to helping those, and myself, in the CAD TUTOR community! Your routine worked flawlessly! I wish you and your family well! :notworthy::notworthy::notworthy::D

 

You're most welcome! Thank you for your gratitude and well wishes, I'm pleased that the code was helpful.

 

Lee

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share

×
×
  • Create New...