Bounding box for all objects?

I seem to remeber being able to return a bounding box of all objects in the current drawing. Similar to the zoom extents. Was I just making this up?

Brian

I got one thanks to Vovka

bbox.zip

;;;***********************************************************************************
;;;PROGRAM CREATED FOR SELECTION SET BOUNDARY
;;;DATE: MAY 2008
;;;BY: wizman
;;;
;;;
;;;
;;;TYPE "BBS" TO START COMMAND
;;;
;;;
;;;
;;; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 

(defun c:BBS (/ all_max all_min ll_pt maxpt minpt myset ur_pt)
 (vl-load-com)
 (setq	all_min	'()
all_max	'()
 ) ;_ end_setq
 (if (setq mySet (ssget))
   ;;"_X" '((410 . "Model"))))
   (progn
     (foreach x
	 (mapcar 'vlax-ename->vla-object
		 (vl-remove-if 'listp
			       (mapcar 'cadr
				       (ssnamex myset)
			       ) ;_ end_mapcar
		 ) ;_ end_vl-remove-if
	 ) ;_ end_mapcar
(vla-GetBoundingBox x 'minpt 'maxpt)
(Setq all_min (cons (trans (vlax-safearray->list minpt) 1 0) all_min))
(Setq all_max (cons (trans (vlax-safearray->list maxpt) 1 0) all_max))
     ) ;_ end_foreach
     (setq LL_pt (list	(car (vl-sort (mapcar 'car all_min) '<))
		(car (vl-sort (mapcar 'cadr all_min) '<))
	  ) ;_ end_list
     ) ;_ end_setq
     (setq UR_pt (list	(last (vl-sort (mapcar 'car all_max) '<))
		(last (vl-sort (mapcar 'cadr all_max) '<))
	  ) ;_ end_list
     ) ;_ end_setq
     (mapcar 'princ (list "\nlower left:>> " ll_pt "\nupper right:>> " ur_pt))
     (grvecs (append '(1)
	      (list ll_pt
		    (list (car ur_pt) (cadr ll_pt))
		    (list (car ur_pt) (cadr ll_pt))
		    ur_pt
		    ur_pt
		    (list (car ll_pt) (cadr ur_pt))
		    (list (car ll_pt) (cadr ur_pt))
		    ll_pt
	      ) ;_ end_list
      ) ;_ end_append
     ) ;_ end_grvecs
     ;;(textpage)
   ) ;_ end_progn
 ) ;_ end_if
 (princ)
) ;_ end_defun
(princ)

Hey Wiz

I am not a LISP programmer; more VBA but does your routine get the points of a bounding box? That is what it looks like to me?

I just did a few things in VBA with the bounding box method.

I am wondering, is there any way to visually make the bounding box appear on screen?

If you guys are interested, I can share my vba code

Thanks

M

hi ML, sure you can post your vba so that others who understand those can learn also. i just edited the above code to visually show the extents.

Hey Wiz

 

I am not a LISP programmer; more VBA but does your routine get the points of a bounding box? That is what it looks like to me?

 

I just did a few things in VBA with the bounding box method.

 

I am wondering, is there any way to visually make the bounding box appear on screen?

 

If you guys are interested, I can share my vba code

 

Thanks

M

Try It.

ECO - External contour of objects

Other version here. LISP. ECO - External Contour of Objects

;| ! *******************************************************************
;; !                  lib:IsPtInView
;; ! *******************************************************************
;; ! Проверяет находится ли точка в видовом экране
;; ! Auguments: 'pt'  - Точка для анализа в МСК!!!
;; ! Return   : T или nil если 'pt' в видовом экране или нет
;; ! *******************************************************************|;
(defun lib:IsPtInView (pt / VCTR Y_Len SSZ X_Pix Y_Pix X_Len Lc Uc)
(setq pt (trans pt 0 1))  
(setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE")
  SSZ (getvar "SCREENSIZE")
  X_Pix (car SSZ) Y_Pix (cadr SSZ)
  X_Len (* (/ X_Pix Y_Pix) Y_Len)
  Lc (polar VCTR (dtr 180.0) (* 0.5 X_Len))
  Uc (polar Lc 0.0 X_Len)
  Lc (polar Lc (dtr 270.0) (* 0.5 Y_Len))
  Uc (polar Uc (dtr 90.0) (* 0.5 Y_Len)))
(if (and (> (car pt) (car Lc))(< (car pt) (car Uc))
 (> (cadr pt) (cadr Lc))(< (cadr pt) (cadr Uc)))
T nil))
(defun DTR (a)(* pi (/ a 180.0)))
;| ! ***************************************************************************
;; !           lib:pt_extents
;; ! ***************************************************************************
;; ! Function : Возвращает границы MIN, MAX X,Y,Z списка точек
;; ! Argument : 'vlist' - Список точек
;; ! Returns  : Список точек (ЛевНижн ПравВерхн)
;; ! ***************************************************************************|;
(defun  lib:pt_extents (vlist / tmp)
(setq tmp (mapcar '(lambda (x) (vl-remove-if 'null x))
(mapcar '(lambda (what) (mapcar '(lambda (x) (nth what x)) vlist))
'(0 1 2))));_setq
 
 (list (mapcar '(lambda(x)(apply 'min x)) tmp)(mapcar '(lambda(x)(apply 'max x)) tmp)));_defun
;http://www.theswamp.org/index.php?topic=15123.0
;;;(defun GetBoundingBox-3d (pt_lst)
;;;  (list (apply 'mapcar (cons 'min pt_lst))
;;; (apply 'mapcar (cons 'max pt_lst))
;;;  )
;;
; ! ***********************************************************
;; !                             lib:Zoom2Lst
;; ! **********************************************************
;; ! Function : Zoom границ списка точек
;; ! Arguments: 'vlist' - Список точек в МСК!!!!
;; ! Зуммирует экран, чтобы все точки были видны
;; ! Returns  : t - было зуммирование nil - нет
;; ! **********************************************************
(defun lib:Zoom2Lst( vlist / bl tr Lst OS)
(setq Lst (lib:pt_extents vlist)
bl (car Lst) tr (cadr Lst))
(if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr)))
(progn  (setq OS (getvar "OSMODE"))(setvar "OSMODE" 0)
(command "_.Zoom" "_Window" (trans bl 0 1)(trans tr 0 1)
 "_.Zoom" "0.95x")
(setvar "OSMODE" OS)
 T) NIL))
;External contour of objects
(defun C:ECO ( / *error* blk obj MinPt MaxPt hiden pt pl unnamed_block isRus
      tmp_blk adoc blks lays lay oname sel csp loc sc ec ret DS osm iNSpT)
(defun *error* (msg)(princ msg)(mapcar '(lambda (x) (vla-put-Visible x :vlax-true)) hiden)
(vla-endundomark adoc)(if (and tmp_blk (not (vlax-erased-p tmp_blk))(vlax-write-enabled-p tmp_blk) )
(vla-Erase tmp_blk))(if osm (setvar "OSMODE" osm))(foreach x loc (vla-put-lock x :vlax-true)))
(vl-load-com)(setvar "CMDECHO" 0)(setq osm (getvar "OSMODE"))
(if (zerop (getvar "WORLDUCS"))(progn(vl-cmdf "_.UCS" "")(vl-cmdf "_.Plan" "")))
(setq isRus (= (getvar "SysCodePage") "ANSI_1251"))
(setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))
       blks (vla-get-blocks adoc) lays (vla-get-layers adoc))
 (vla-startundomark adoc)(if isRus (princ "\nВыберите объекты для построения контура")(princ "\nSelect objects for making a contour"))
 (vlax-for lay lays
     (if (= (vla-get-lock lay) :vlax-true)
         (progn (vla-put-lock lay :vlax-false) (setq loc (cons lay loc))))
     )
(if (setq sel (ssget))(progn
   (setq sel (ssnamex sel))
;;;    (setq iNSpT(apply 'mapcar (cons 'min 
;;;     (mapcar 'cadr (apply 'append (mapcar '(lambda(x)(vl-remove-if-not 'listp x)) sel))))))
   (setq iNSpT '(0 0 0))
   (setq sel (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr sel))))
   (setq csp (vla-objectidtoobject adoc (vla-get-ownerid (car sel))))
  ; (setq unnamed_block (vla-add (vla-get-blocks adoc)(vlax-3d-point '(0. 0. 0.)) "*U"))
   (setq unnamed_block (vla-add (vla-get-blocks adoc)(vlax-3d-point inspt) "*U"))
   (foreach x sel
     (setq oname (strcase (vla-get-objectname x)))
     (cond ((member oname '("ACDBVIEWPORT" "ACDBATTRIBUTEDEFINITION" "ACDBMTEXT" "ACDBTEXT")) nil)
    ((= oname "ACDBBLOCKREFERENCE")
     (vla-InsertBlock unnamed_block
       (vla-get-insertionpoint x)(vla-get-name x)
       (vla-get-xscalefactor x)(vla-get-yscalefactor x)
       (vla-get-zscalefactor x)(vla-get-rotation x))
     (setq blk (cons x blk)))
    (t (setq obj (cons x obj)))));_foreach
       (setq lay  (vla-item lays (getvar "CLAYER")))
       (if (= (vla-get-lock lay) :vlax-true)(progn (vla-put-lock lay :vlax-false) (setq loc (cons lay loc))))
    (if obj (progn (vla-copyobjects (vla-get-activedocument (vlax-get-acad-object))
             (vlax-make-variant (vlax-safearray-fill
                 (vlax-make-safearray vlax-vbobject (cons 0 (1- (length obj))))
                 obj)) unnamed_block)))
   (setq obj (append obj blk))
   (if obj (progn
         ;(setq tmp_blk (vla-insertblock csp (vlax-3d-point '(0. 0. 0.))(vla-get-name unnamed_block) 1.0 1.0 1.0 0.0))
             (setq tmp_blk (vla-insertblock csp (vlax-3d-point inspt)(vla-get-name unnamed_block) 1.0 1.0 1.0 0.0))
         (vla-GetBoundingBox tmp_blk 'MinPt 'MaxPt)  ;_Границы блока
              (setq MinPt (vlax-safearray->list MinPt) MaxPt (vlax-safearray->list MaxPt)
      DS (max (distance MinPt (list (car MinPt)(cadr MaxPt)))
       (distance MinPt (list (car MaxPt)(cadr MinPt))))
             DS (* 0.2 DS) ;1/5
      DS (max DS 10) MinPt (mapcar '- MinPt (list DS DS))
                    MaxPt (mapcar '+ MaxPt (list DS DS)))
(lib:Zoom2Lst (list MinPt MaxPt))(setq sset (ssget "_C" MinPt MaxPt))
(if sset (progn (setvar "OSMODE" 0)
     (setq hiden (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
    hiden (vl-remove tmp_blk hiden))
     (mapcar '(lambda(x)(vla-put-Visible x :vlax-false)) hiden)
     (setq pt (mapcar '+ MinPt (list (* 0.5 DS)(* 0.5 DS))))
     (vl-cmdf "_.RECTANG" (trans MinPt 0 1)(trans MaxPt 0 1))
     (setq pl (vlax-ename->vla-object(entlast)))
     (setq sc (1-(vla-get-count csp)))
     (if (VL-CATCH-ALL-ERROR-P (VL-CATCH-ALL-APPLY '(lambda ()
        (vl-cmdf "_-BOUNDARY" (trans pt 0 1) "")
             (while (> (getvar "CMDACTIVE") 0)(command "")))))
     (if isRus (princ "\nНе удалось построить контур")(princ "\nIt was not possible to construct a contour")))
     (setq ec (vla-get-count csp))
       (while (< sc ec)(setq ret (append ret (list (vla-item csp sc))) sc(1+ sc)))
     (setq ret (vl-remove pl ret))
     (mapcar '(lambda (x)(vla-Erase x)(vlax-release-object x))(list pl tmp_blk))(setq pl nil tmp_blk nil)
     (setq ret (mapcar '(lambda ( x / mipt)(vla-GetBoundingBox x 'MiPt nil)  ;_Границы блока
                (setq MiPt (vlax-safearray->list MiPt))(list MiPt x)) ret))
     (setq ret (vl-sort ret '(lambda (e1 e2)(< (distance MinPt (car e1))(distance MinPt (car e2))))))
     (setq pl (nth 1 ret) ret (vl-remove pl ret)) (mapcar 'vla-erase (mapcar 'cadr ret))
     (mapcar '(lambda(x)(vla-put-Visible x :vlax-true)) hiden)
     (foreach x loc (vla-put-lock x :vlax-true))
     (if pl (progn (initget  "Yes No")
     (if (= (getkword (if isRus "\nУдалять объекты? [Yes/No] <No> : " "\nDelete objects? [Yes/No] <No> : ")) "Yes")
        (mapcar '(lambda (x) (if (vlax-write-enabled-p x)(vla-Erase x))) obj)))
(if isRus (princ "\nНе удалось построить контур")(princ "\nIt was not possible to construct a contour")))))))
    (VL-CATCH-ALL-APPLY '(lambda ()(mapcar 'vlax-release-object
   (list unnamed_block tmp_blk csp blks lays))))));_if not
 (foreach x loc (vla-put-lock x :vlax-true))(setvar "OSMODE" osm)
 (vla-endundomark adoc)(vlax-release-object adoc)(princ))

Very nice job Vladimir !

That is nice VLAD! Pretty cool how you show an animation, that helps

Wiz, I just copied your code, I am going to try it.

That would be cool to visually see the bounding box if that is what it does.

I will go look now.

Here is the code I have....

This will prompt you for the blockreference, after you select the blkref, it will get the midpoint of the bounding box of that blkref and prompt you for a destination point.

Very useful for centering blocks, if necessary

If I am going to create a bunch of slides, I will set up a grid (array) in ACAD, then insert all my blocks into that drawing, then with this code, I can place then all on the center tick real easily.

Then I have code for creating the slides for all of the blocks in that drawing in one pop.

M

Sub BlkRefMidPtToDest()
 On Error Resume Next
 ThisDrawing.SelectionSets.Item("Sset").Delete

 Dim BlkRef As AcadBlockReference
 Dim SelSet As AcadSelectionSet
 Dim Ent As AcadEntity
 Dim minExt As Variant
 Dim maxExt As Variant
 Dim pntCent(0 To 2) As Double
 Dim pntMoveTo As Variant
 Dim grpcode(0) As Integer
 Dim dataval(0) As Variant

 grpcode(0) = 0
 dataval(0) = "insert"

 Set SelSet = ThisDrawing.SelectionSets.Add("Sset")
 SelSet.SelectOnScreen grpcode, dataval

 For Each Ent In SelSet
  If TypeOf Ent Is AcadBlockReference Then
   Set BlkRef = Ent
   BlkRef.GetBoundingBox minExt, maxExt
   pntCent(0) = (minExt(0) + maxExt(0)) / 2
   pntCent(1) = (minExt(1) + maxExt(1)) / 2
   pntCent(2) = (minExt(2) + maxExt(2)) / 2
   BlkRef.Highlight True
   pntMoveTo = ThisDrawing.Utility.GetPoint(, "Select Destination Point: ")
   BlkRef.Move pntCent, pntMoveTo
  End If
 Next Ent
 SelSet.Delete
End Sub

Wiz

That lisp routine is pretty cool

I only tried it on a block so far but will it work on all entites that have a bounding box?

Also, that would be really cool if you made it so that the user can pick the entity that they want to see the bounding box for.

That is how I would like to use it

Mark

hi ML, user can now have a selection. also, good code you made vva.

Wiz

That lisp routine is pretty cool

I only tried it on a block so far but will it work on all entites that have a bounding box?

 

Also, that would be really cool if you made it so that the user can pick the entity that they want to see the bounding box for.

 

That is how I would like to use it

Mark

I'm late to the game, but would there be a way to increase the buffer on this lisp? As in ignore certain size gaps?

I'm late to the game, but would there be a way to increase the buffer on this lisp? As in ignore certain size gaps?

For creating an outline ignoring gaps you can try TotalBoundary utility.

See this video:

Thanks, I've used TotalBoundary before, and it rocks! But it doesn't quite work the way I'd like for the project I'm thinking of + I'd like to be able to incorporate the code into a LISP with added components.

But thanks!

I'm late to the game, but would there be a way to increase the buffer on this lisp? As in ignore certain size gaps?