Simple Text to MText routine
I have tired to no avail to find a LISP that converts one or more strings of Text to MTEXT and leave the original (or first picked if multiple texts) untouched in all its attributes - position, style, size, rotation etc.
I have found quite a few that do this but change other attributes that then need editing.
I thought I'd collected one along the way, but it too evades me.
Any help is very much appreciated thanks.
I have found quite a few that do this but change other attributes that then need editing.
I thought I'd collected one along the way, but it too evades me.
Any help is very much appreciated thanks.
0
Comments
-
Send me a DWG with your worst case scenarios to dotson [at] dotsoft [dot] com. I'll put together a robust tool and add it to our growing list of BricsCAD freeware.0
-
I was just looking for something like this myself. The Sofoco Tools would seem to be the solution but I have not been able to get it working. (I contacted their tech support)Where is the one Terry Dotson made?-Joe0
-
...Where is the one Terry Dotson made?
Text: To AttDef, Mtext, Mtext Multiple, Attributes, or Attributes Multiple
http://www.dotsoft.com/toolpac.htm0 -
I did get a reply from the Sofoco folks. They needed to correct an error with the CUI file. But, my main issue was that I was selecting the text first, when they should be chosen after clicking the action button.I don't know if they have updated the download yet, but their Sofoco Tools program is free on the BricsCAD application library.-Joe0
-
A bit more about the Sofoco Tools program.I thought the program wasn't working properly on some text, but it it turned out they were each already individual Mtext. That caused them to not be selectable, since the program was filtering them out.I tried exploding them to turn them into text, but one of the lines had different sized fonts, and BricsCAD will explode each size into separate Text objects. So, things get a bit tricky.-Joe0
-
Hi Joe,
I updated Sofoco Tools with the fix for the image error message.
See:
http://www.sofoco.com.au/sofocotools.html
cheers,
Damian0 -
This routine was modified by me to sort by y position to allow window picking. 2-returns at the start will give you all caps.
This routine is GOLD in terms of usefulness.
JP
(defun c:t2 ( / ss ename enamedel edata edatan edata1 y y1 y2 x ipt hj ht wid1 wid n ETYPE caps ROT)
(osorth1 0 2)
(defun jthree (txt edatan / first3 L3 Ltxt)
(setq first3 (cdr (assoc '3 edatan))
L3 (strlen first3)
Ltxt (strlen txt) )
(if (= L3 250) (setq edatan (cons (cons '3 txt) edatan))
(progn
(if (<= (+ L3 Ltxt) 250) (setq edatan (subst (cons '3 (strcat first3 txt))(cons '3 first3) edatan))<br> (setq edatan (subst (cons '3 (strcat first3 (substr txt 1 (- 250 L3))))(cons '3 first3) edatan)
edatan (cons (cons '3 (substr txt (- 251 L3))) edatan)
)))))
(WHILE (NOT SS)
(princ "\nSelect Text or for All Caps")(setq ss (ssget '((-4 . ""))))
(IF (not SS) (PRINC (SETQ CAPS "CAPS_ON")))) ;allow for conversion to upper case
(setq wid1 0 len1 (sslength ss) len2 len1 n len1 y1 nil y2 nil edatan (list (cons '3 "")) )
(while (>= len1 1)
(while (>= len2 1)
(setq ename (ssname ss (1- len2)) )
(setq edata (entget ename) )
(if (= n 1) (progn
(SETQ ROT (CDR (ASSOC '50 EDATA)))(PRINC "ROT=")(PRINC ROT)
(setq ht (cdr (assoc '40 edata)))(setvar "textsize" ht) (princ "/nText height = ")(princ ht)
(setvar "textstyle" (cdr (assoc '7 edata)))(setvar "textsize" ht)
(setvar "clayer" (cdr (assoc '8 edata)))
(if (eq "TEXT" (cdr (assoc '0 edata)) )(setq ETYPE "TEXT" hj (cdr (assoc '72 edata) ) )
(setq ETYPE "MTEXT" hj (- (cdr (assoc '71 edata)) 1) ) )
(setq hj (cond ((= hj 1) "tc") ((= hj 2) "tr") (hj "tl") )) ) )
(setq n (1- n))
(if (eq "TEXT" (cdr (assoc '0 edata)) )
(setq wid (car (cadr (textbox (list (cons 1 (strcat (cdr (assoc 1 edata)) "X")))))))
(setq wid (cdr (assoc '41 edata)) ) )
(if (> wid wid1) (setq wid1 wid) )
(setq y (caddr (assoc '10 edata))
len2 (1- len2) )
(if (not y1) (setq y1 (1- y) ) )
(if (>= y y1) (progn (setq x (cadr (assoc '10 edata))
y1 y )
(if (= y (caddr (assoc '11 edata)))
(setq x (cadr (assoc '11 edata)) ) ) ) )
(if (not y2) (setq y2 (1- y) ) )
(if (>= y y2) (setq edata1 edata
y2 y
enamedel ename )
)
);end while len2
(if (= n 0) (progn
(IF (AND (EQ ETYPE "TEXT") (= HJ "tl") )
(setq ipt (polar (list x y1) (+ ROT 1.385) (* ht 1.02)))
(setq ipt (list x y1) ) )
(command "mtext" ipt "j" hj "R" (RADDEG ROT) "w" WID1) ))
(while (cdr (assoc '3 edata1))
(if (NOT CAPS) (setq edatan (jthree (cdr (assoc '3 edata1)) edatan)
edata1 (subst '( 2 2 3) (assoc '3 edata1) edata1) )
(setq edatan (jthree (strcase (cdr (assoc '3 edata1))) edatan)
edata1 (subst '( 2 2 3) (assoc '3 edata1) edata1) )
)
)
(if (NOT CAPS) (setq edatan (jthree (cdr (assoc '1 edata1)) edatan) )
(setq edatan (jthree (strcase (cdr (assoc '1 edata1))) edatan) )) ;allow for conversion to upper case
(ssdel enamedel ss)
(setq len1 (1- len1)
y2 nil
len2 (sslength ss) )
(if (or (= len1 0) (wcmatch (substr (cdr (car edatan)) (strlen (cdr (car edatan)))) " ")) (princ)
(setq edatan (jthree " " edatan) ) )
);end while len1
(command "" ".erase" "p" "")
(setq edatan (reverse edatan)
edatan (subst (cons '1 (cdr (car edatan))) (car edatan) edatan)
edata (entget (entlast))
edata (subst (car edatan) (assoc '1 edata) edata)
edatan (cdr edatan) )
(if (assoc '3 edatan) (setq edata (append edata edatan) ) )
(entmod edata)
(osorth2)
(princ))0 -
sorry i couldn't edit the last code post. Get rid of the osorth subroutines at the start and end, they just turn osnap off and return back where you were when finished.0
This discussion has been closed.