Lisp error for draw a rectangle bounding box in multiple block

[Anonymous]

Hello everyone, I am new learn to Lisp. I tried to modify a lisp to draw a rectangular bounding box in multiple blocks, i have a thousand block in a drawing. but I have no idea to modified this lisp problem.

The following error is this:

(every block should it own bounding box) 

but

(the error is all block bounding box include each others. it mess up)

i wish some one lisp expert can help me to accomplish. thanks all.

(defun c:rblk (/ ss minpt maxpt eLL eUR LL UR)

  (setq lst nil)
  (while (setq def (tblnext "block" (not def)))
    (if (zerop (logand 125 (cdr (assoc 70 def))))
      (setq lst (cons (cdr (assoc 2 def)) lst))
      )
    )
  (setq ntotal (length lst))
  (princ (strcat "Number of blocks: " (itoa ntotal)))
  

  (setq lstlength(length lst)) 								;; Determine how many blocks are in the drawing - to iterate through them
  (setq n 0)										;; initialize the counter
  (cond (lst										;; Verify that we have blocks at all.
	 (repeat lstlength									;; Iterate through each item in the list of blocks.
	   ;;(princ (strcat "Editing block: " (nth n lst)))
	   (command-s "_.bedit" (nth n lst))							;; bedit a block
 
          ;(setq ss nil)	
           


 (vl-load-com) 

 (setq lay "My Boxing Layer" ;; Layer			

       offset 3.  ;; Offset				

       thgt 0   ;; Text Height / position		

 )

 (defun *error* (msg)
   (and uFlag (vla-EndUndomark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 
 (defun LWPoly (lst cls)
   (entmakex (append (list (cons 0 "LWPOLYLINE")
                           (cons 100 "AcDbEntity")
                           (cons 100 "AcDbPolyline")
                           (cons 8 lay)
                           (cons 90 (length lst))
                           (cons 70 cls))
                     (mapcar (function (lambda (p) (cons 10 p))) lst))))

 (defun Text (pt hgt str)
   (entmakex (list (cons 0 "TEXT")
                   (cons 8 lay)
                   (cons 10  pt)
                   (cons 40 hgt)
                   (cons 1  str)
                   (cons 72 1)
                   (cons 73 2)
                   (cons 11 pt))))

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))
 

(if (setq ss (ssget "_X"))
   (progn
     (setq uFlag (not (vla-StartUndoMark *doc)))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc))
       
       (vla-getBoundingbox obj 'Mi 'Ma)
       (setq pts (cons (vlax-safearray->list Mi)
                       (cons (vlax-safearray->list Ma) pts))))
     (vla-delete ss)
     (setq Mi (apply (function mapcar) (cons 'min pts))
           Ma (apply (function mapcar) (cons 'max pts)))

     (setq Poly
       (LwPoly (list (list (- (car Mi) offset)
                           (- (cadr Mi) Offset) 0.)
                     (list (- (car Mi) offset)
                           (+ (cadr Ma) offset) 0.)
                     (list (+ (car Ma) offset)
                           (+ (cadr Ma) offset) 0.)
                     (list (+ (car Ma) offset)
                           (- (cadr Mi) offset) 0.)) 1))

     (setq num
       (if (setq i -1 floor 1 ss (ssget "_X" (list (cons 0 "TEXT") (cons 8 lay))))
         (progn
           (while (setq ent (ssname ss (setq i (1+ i))))
             (if (< floor (setq nNum (atoi (cdr (assoc 1 (entget ent))))))
               (setq floor nNum)))

           (itoa (1+ floor))) "1"))

     (setq TObj
       (Text (list (/ (+ (car Mi) (car Ma)) 2.)			
                   (+ (cadr Mi) (+ Offset tHgt)) 0.) thgt num))	



     (if (not (vl-catch-all-error-p
                (setq Grp
                  (vl-catch-all-apply
                    (function vla-Add)
                      (list (vla-get-Groups *doc) (strcat "BoxNumber_" num))))))
       
       (vla-AppendItems Grp
         (vlax-make-variant
           (vlax-safearray-fill
             (vlax-make-safearray
               vlax-vbObject '(0 . 1))
             (mapcar
               (function vlax-ename->vla-object) (list Poly tObj)))))

       (princ (strcat "\n** Error Creating Group: "
                      (vl-catch-all-error-message Grp) " **")))
     
     (setq uFlag (vla-EndUndoMark *doc))))      

 (princ)




	   (terpri) (princ (strcat "Completed " (itoa (1+ n)) " out of " (itoa ntotal)))	;; progress updates
	   (setq n (1+ n))									;; 1+ on the iterative counter
	   (command-s "_.bsave")								;; save the block
	   )
	 (command-s "_.bclose" "_sav")
	 )
	)
  (terpri)
  )

[doaiena]

I haven't looked at your code, but try (setvar "osmode" 0), and run your function again. 

[Anonymous]

---

@doaiena wrote:

I haven't looked at your code, but try (setvar "osmode" 0), and run your function again. 

---

unfortunately, the result still same,thanks for input.

[doaiena]

Like i said, turn off snaps and you should also reset your "pts" variable. You are constantly adding points there. Your "undo" mark is inside a loop, you should move it outside, in order to work as expected.

[Kent1Cooper]

It's not an error, and it's not an Object Snap issue -- it does just what it's designed to do.  It finds the extents of all objects, and takes the minimum and maximum X and Y coordinates from the list of all those, which define the overall collective extents, which it uses to draw a rectangle.

I have a routine to draw the bounding box around any object, which I can easily modify for multiple-object selection, but not right now -- coming later, if someone else doesn't beat me to it.

[Kent1Cooper]

---

@Kent1Cooper wrote:

....

I have a routine to draw the bounding box around any object, which I can easily modify for multiple-object selection, but not right now -- coming later....

---

Try this [lightly tested]:

(vl-load-com)
(defun C:DBB (/ n); = Draw Bounding Boxes
  (prompt "\nTo draw bounding boxes around each,")
  (if (setq ss (ssget))
    (repeat (setq n (sslength ss)); then
      (vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq n (1- n)))) 'minpt 'maxpt)
      (command "_.rectangle" "_none" (vlax-safearray->list minpt) "_none" (vlax-safearray->list maxpt))
    ); repeat
  ); if
  (princ)
); defun
(prompt "\nType DBB to Draw the Bounding Boxes of selected object(s).")

That's just the boxes, as in your illustration.  There's more to the code you posted, which the above doesn't do.

[Anonymous]

Hi, KENT COOPER, I really appreciate your shared code, but I think there is a misunderstanding. My code is: all objects in each block are bounded by a rectangular bounding box. So the code might be: block edit > bounding box overall object (because it is all object in the block, so there is only one rectangle in block) > save block, close block > next block until all blocks are completed.

[Moshe-A]

@Anonymous  hi,

please explain why bound each block with a rectangle?

moshe

[Anonymous]

I tried to explain it in my bad English 🙂 That's it, because each block has a rectangular box that makes it easier to align in another table. I have to make a table form to export the list to other software.