Automate to create bounding box for all text objects

[ernstloeffel]

Hi all,

 

I'm new to both AutoCad (actually Map 3D) and AutoLisp. I need to create a plugin which creates the bounding boxes for all text objects, and write these bounding boxes to a layer named after a specific scheme, like OriginalLayerName_BoundingBox. So for an example, when a text object is on layer "rooms" the boundary should be created and stored on rooms_BoundingBox.

 

I'd be very grateful if you could share your LISP expertise with me. I've tried to step into Lisp and AutoCad for a few hours now already, but this task seems a bit too challenging for a "hello world".

 

Below is the basic script that I have working. It doesn't do more than create bounding boxes which are selected manually, using some fixed arguments to TCIRCLE as I need.

 

(defun c:MyBounds ( / ss)

(if (not bns_tcircle) (load "acettxt.lsp"))

(if (setq ss (ssget '((0 . "TEXT,MTEXT,ATTDEF"))))

(bns_tcircle ss "Variable" "Rectangles" "" 0.35)

)

(princ)

)

 

My attempts to reflect the functionality above resulted so far just in spagehtti code.

 

It would be great if you could edit my script for what I need, but even greater if you could also explain it to me.

[MSasu]

Welcome to the Forum, Ernstloeffel!

 

Please check if this helps you:

(defun c:MyBounds ( / suffixLayer ss nameEnt assocEnt nameLayer )
(if (not bns_tcircle) (load "acettxt.lsp"))
(setq suffixLayer "_BoundingBox")                                      ;define suffix for boundin boxes layers

(if (setq ss (ssget "_X" '((0 . "TEXT,MTEXT,ATTDEF"))))                ;select all labels from drawing
 (while (> (sslength ss) 0)                                            ;parse selection set until empty
  (setq nameEnt  (ssname ss 0)                                         ;retrive first entry from selection set
        assocEnt (entget nameEnt))                                     ; and its features list

  (if (not (tblsearch "LAYER" (setq nameLayer                          ;test if target layer exists
                                    (strcat (cdr (assoc 8 assocEnt))   ;append the prefix
                                            suffixLayer))))
   (command "_LAYER" "_N" nameLayer "")                                ;create the new layer
  )

  (bns_tcircle (ssadd nameEnt)  "Variable" "Rectangles" "" 0.35)       ;add the bounding box
  (command "_CHPROP" (entlast) "" "_LA" nameLayer "")                  ;move it into its layer

  (setq ss (ssdel nameEnt ss))                                         ;remove processed entry from selection set
 )

)
(princ)
)

[SLW210]

Please read the Code Posting Guidelines and edit your post to include the Code in Code Tags.

[ernstloeffel]

Welcome to the Forum, Ernstloeffel!

 

)[/code]

 

Thank you very much! I can try it only on Monday, but with your example and comments help me a lot.

 

Cheers

Ernstloeffel

[Rroger_D]

Hi MSasu,

 

You seem like a chap up for a challenge? Sorry if this is seen as 'hijacking' this post, but it looks old and dead

 

I am running around in rings trying to sort out a routine to autodelete overlapping text. the drawings are in 3D but obviously the overlap in the 2D plane needs only be considered. I tested out your Lisp as above. The bounding rectangles that come up, I think goes part way to resolving this.

 

The way I see it is:

 

1 - user selects area containing overlapping text elements

2 - function searches for first (any) piece of text

3 - checks if it's boundary overlaps another text boundary

4 - if no, return to 2 and repeats

5 - if yes, delete that which it overlaps

6 - return to 3

7 - end

 

In an ideal world, I would use on the drawing as a whole and it would check against text on different layers. Each layer would have an importance (weighting) value. In the short term however and simpler, I could run it layer by layer.

 

I am totally new to Lisp. Any help would be gratefully received.

 

Many thanks.

 

Rroger_D

[gadgetjay]

Hi,

 

 

I know this is an old thread but worth a try!

 

 

I'm trying to change this code to circle to all objects and a selected layer..(as TCIRCLE would) but end up with a "Tic Tac'

 

 

I have changed the code to

 

 

(defun c:MYBOUNDS ( / ss nameEnt assocEnt )

(if (not bns_tcircle) (load "acettxt.lsp"))

(command "CLAYER" "Adim") ;selects correct layer

(if (setq ss (ssget "x" (list (cons 8 "ADim")))) ;select all labels on Adim layer

(while (> (sslength ss) 0) ;parse selection set until empty

(setq nameEnt (ssname ss 0) ;retrive first entry from selection set

assocEnt (entget nameEnt)) ; and its features list

 

(bns_tcircle (ssadd nameEnt) "Variable" "C" "" 0.35) ;add the bounding box

 

(if (setq tt (ssget "_x" '((0 . "*POLYLINE") (8 . "ADim")))) ;thickens all polylines on layer

(command "_.pedit" "_m" tt "" "w" 50 ""))

 

(setq ss (ssdel nameEnt ss)) ;remove processed entry from selection set

(setq tt (ssdel nameEnt tt)) ;remove processed entry from selection set

))

 

(princ)

)

 

 

How do I change this to a get standard circle?

[Lee Mac]

Quick mod:

(defun c:mybounds ( / ent sel )
   (cond
       (   (and (not bns_tcircle) (progn (load "acettxt.lsp" nil) (not bns_tcircle)))
           (princ "\nPlease install Express Tools.")
       )
       (   (setq sel (ssget "_X" '((0 . "TEXT,MTEXT,ATTDEF") (8 . "ADim"))))
           (setq ent (LM:entlast (entlast)))
           (bns_tcircle sel "Variable" "Circles" "" 0.35)
           (while (setq ent (entnext ent)) (entmod (list (cons -1 ent) '(8 . "ADim"))))
       )
   )
   (princ)
)

;; Entlast  -  Lee Mac
;; Returns the last entity in the drawing database after a given entity

(defun LM:entlast ( ent / tmp )
   (if (setq tmp (entnext ent)) (LM:entlast tmp) ent)
)

(princ)

[gadgetjay]

Thanks Lee you are a star!

[Lee Mac]

You're welcome