Jump to content

Bounding box for all objects?

bsamc2000

By bsamc2000
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

bsamc2000 Contributor

bsamc2000

Posted
Posted

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

wizman Rising Star

wizman

Posted
Posted 
;;;***********************************************************************************
;;;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)

ML0940 Enthusiast

ML0940

Posted
Posted

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

wizman Rising Star

wizman

Posted
Posted

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

VVA Rising Star

VVA

Posted
Posted (edited)

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))

eco.gif

Edited by VVA
ML0940 Enthusiast

ML0940

Posted
Posted

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

ML0940 Enthusiast

ML0940

Posted
Posted

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

wizman Rising Star

wizman

Posted
Posted

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

  • 8 years later...
eyeofnewt555 Enthusiast

eyeofnewt555

Posted
Posted

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?

Debalance Enthusiast

Debalance

Posted
Posted
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:

eyeofnewt555 Enthusiast

eyeofnewt555

Posted
Posted

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!

Roy_043 Mentor

Roy_043

Posted
Posted
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?
If you are talking about the code that uses the _Boundary command changing the HPGAPTOL setting should work.

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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
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
Go to topic listing
×
×
  • Create New...