Break Dtext

The following code works great. I was wanting to modify it to keep breaking text
until nothing is sellected. Any ideals on how to best do this?

Gary

;;;Break text
;;;written: Andrzej GUMULA
(defun C:BTX (/ ELEM ETYK CM OS OLDERR PTW PT10 TMP ODL OPIS TBOX ITEM)
(defun FILE:ERROR ()
(command "_undo" "_e")
(setq *ERROR* OLDERR)
(setvar "OSMODE" OS)
(setvar "CMDECHO" CM)
(princ)) ;end file:error
(defun XY (A) (list (car A) (cadr A))) ;end xy
(defun DXF (A B) (cdr (assoc A B))) ;end dxf
(defun STRIM (A)
(while (member (substr A 1 1) (list " " "," "." "-" ";"))
(setq A (substr A 2))) ;_ end of while
A) ;end strim
(defun PRPT (A B)
(if (not (assoc A ELEM))
(setq ELEM (append ELEM (list (cons A B))))) ;_ end of if
ELEM) ;end prpt
(setq OLDERR *ERROR*
*ERROR* FILE:ERROR
ELEM NIL
CM (getvar "CMDECHO")
OS (getvar "OSMODE")) ;_ end of setq
(setvar "CMDECHO" 0)
(setvar "OSMODE" 0)
(command "_undo" "_be")

(while (not (eq (DXF 0 ELEM) "TEXT"))
(setq ETYK (entsel "\n* Pick a Text to Break *"))
(if ETYK
(setq ELEM (entget (car ETYK)))) ;_ end of if
) ;_ end of while
(setq PTW (XY (trans (cadr ETYK) 1 0)))
(command "_ucs" "_ob" (car ETYK))
(setq PTW (trans PTW 0 1)
OPIS (DXF 1 ELEM)
ITEM 1
TEMP 0.0) ;_ end of setq
(while (or (not (member (substr OPIS ITEM 1) (list "" "." ";" "," "-" " ")))
(< TEMP (car PTW))) ;_ end of or
(setq TBOX (textbox (subst (cons 1 (substr OPIS 1 ITEM)) (assoc 1 ELEM)
ELEM)) ;_ end of textbox
TEMP (- (caadr TBOX) (caar TBOX))
ITEM (1+ ITEM)) ;_ end of setq
) ;end while
(entmod (subst (cons 1 (substr OPIS 1 (1- ITEM))) (cons 1 OPIS) ELEM))
(setq A (append A (list '(62 . 4))))
(PRPT 62 256)
(PRPT 6 "BYLAYER")
(entmake
(subst (cons 1 (STRIM (substr OPIS (1+ ITEM)))) (cons 1 OPIS) ELEM)) ;_ end
of entmake
(command "_move" (entlast) "" "0,0" (list 0 (- (* 1.4 (DXF 40 ELEM))))) ;_ end
of command
(command "_ucs" "_p")
(command "_undo" "_e")
(setq *ERROR* OLDERR)
(setvar "OSMODE" OS)
(setvar "CMDECHO" CM)
(princ)) ;_ end of defun

 

Thanks Tim, this a great routine. The one I posted is faster, because you select
the text
break postion with the dtext string and it automaticlly repositions the dtext to
the next line below.
What I need to do to my routine is to repeat the command (loop it) until you
select nothing.

Sometimes I want to break a dtext string two or more times, and have it
repostioned automatically.

original string:
PLINTH FOR COLUMN BASE 3,000 PSI NON SHRINK GROUT

first break:
PLINTH FOR COLUMN
BASE 3,000 PSI NON SHRINK GROUT

second break:
PLINTH FOR COLUMN
BASE 3,000 PSI NON
SHRINK GROUT

So how would I modify my routine to do this...any help tips.

Gary

 

Gary,

See if this will work for you.

Tim

;;;Break text
;;;written: Andrzej GUMULA
(defun C:BTX (/ ELEM ETYK CM OS OLDERR PTW PT10 TMP ODL OPIS TBOX ITEM)
(defun FILE:ERROR ()

(command "_undo" "_e")
(setq *ERROR* OLDERR)
(setvar "OSMODE" OS)
(setvar "CMDECHO" CM)
(princ)) ;end file:error

(defun XY (A) (list (car A) (cadr A))) ;end xy

(defun DXF (A B) (cdr (assoc A B))) ;end dxf

(defun STRIM (A)
(while (member (substr A 1 1) (list " " "," "." "-" ";"))
(setq A (substr A 2))
) ;_ end of while
A) ;end strim

(defun PRPT (A B)
(if (not (assoc A ELEM))
(setq ELEM (append ELEM (list (cons A B))))
) ;_ end of if
ELEM
) ;end prpt

(setq OLDERR *ERROR*
ELEM NIL
CM (getvar "CMDECHO")
OS (getvar "OSMODE")
) ;_ end of setq
;------------------- *ERROR* FILE:ERROR
(setvar "CMDECHO" 0)
(setvar "OSMODE" 0)
(command "_undo" "_be")

(while (setq ETYK (entsel "\n* Pick a Text to Break *"))
(if (and (setq ELEM (entget (car ETYK))) (eq (DXF 0 ELEM) "TEXT"))
(progn
(setq PTW (XY (trans (cadr ETYK) 1 0)))
(command "_ucs" "_ob" (car ETYK))
(setq PTW (trans PTW 0 1)
OPIS (DXF 1 ELEM)
ITEM 1
TEMP 0.0
) ;_ end of setq
(while
(or
(not (member (substr OPIS ITEM 1) (list "" "." ";" "," "-" " ")))
(< TEMP (car PTW))
) ;_ end of or
(setq TBOX (textbox (subst (cons 1 (substr OPIS 1 ITEM)) (assoc 1 ELEM) ELEM)) ;_ end of textbox
TEMP (- (caadr TBOX) (caar TBOX))
ITEM (1+ ITEM)
) ;_ end of setq
) ;end while
(entmod (subst (cons 1 (substr OPIS 1 (1- ITEM))) (cons 1 OPIS) ELEM))
(setq A (append A (list '(62 . 4))))
(PRPT 62 256)
(PRPT 6 "BYLAYER")
(entmake (subst (cons 1 (STRIM (substr OPIS (1+ ITEM)))) (cons 1 OPIS) ELEM)) ;_ end of entmake
(command "_move" (entlast) "" "0,0" (list 0 (- (* 1.4 (DXF 40 ELEM))))) ;_ end of command
)
)
) ;_ end of while
(command "_ucs" "_p")
(command "_undo" "_e")
(setq *ERROR* OLDERR)
(setvar "OSMODE" OS)
(setvar "CMDECHO" CM)
(princ)
) ;_ end of defun

 

THANK YOU

You are the man....now that is sweet.
Thanks again.

Gary

 

What I did was put the whole (main) function in condition with the while function, so while you select something it will work.

Glad it works the way you want.
Tim

 

Here is how I use the routine.
1. I pick a text string from my dialog box...and place the string to the correct
layer.
2. Run the BTX routine....as required to break the dtext string.
3. Place my arrow leader from note placed to object noted.

I have to reset the UCS back to world....my reset vars did not pick this up from
the
BTX routine. When I cancel out of the BTX, I need to reset the UCS, correct?

Gary

 

(defun FILE:ERROR ()
(command "_undo" "_e")
(setq *ERROR* OLDERR)
(setvar "OSMODE" OS)
(setvar "CMDECHO" CM)
(command "ucs" "w")
(princ)) ;end file:error

This fixed the UCS
I quess this is ok...it seems to work.

Thanks, thanks again.

Gary

 

I would think so since the btx routine only sets it to previous not world.

Tim