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:
46.png(every block should it own bounding box)
but
45.png(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)
)