Jump to content

Automate to create bounding box for all text objects


ernstloeffel
 Share

Recommended Posts

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.

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

  • 4 months later...

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

Link to comment
Share on other sites

  • 1 year later...

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?

Link to comment
Share on other sites

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)

Link to comment
Share on other sites

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

×
×
  • Create New...