;  c. 2006 Jeff Rayhorn & LukewarmCoffee.com
;  T2A is the text-2-attribute routine
;  T2M is the text-2-mtext routine
;  textrect draws a rectangle around text
;  txtwidth changes the width of the selected dtext
;  attwidth changes the width of attributed text
(defun T2A
  ( /
    txtent   ; "TEXT" entity name
    txtlst   ; Entity list for "txtent"
    attlst   ; Entity list for "ATTDEF"
  )
  (setq txtent nil)
  (while (not txtent)
   (setq txtent
    (car (entsel "\n Pick TEXT to convert:"))
   );end setq
   (if txtent (setq txtlst (entget txtent)))
  );end while

  (if
   (/= "TEXT" (cdr (assoc 0 txtlst))) ;test if "TEXT"
   (alert "Only TEXT entities can be converted.")
   (progn
    (entdel txtent)
    (setq attlst
     (list
         '(0 . "ATTDEF")
         '(100 . "AcDbEntity")
         (assoc 8 txtlst)
         '(100 . "AcDbText")
         (assoc 10 txtlst)
         (assoc 40 txtlst)
         '(1 . "")
         (assoc 50 txtlst)
         (assoc 41 txtlst)
         (assoc 51 txtlst)
         (assoc 7 txtlst)
         (assoc 71 txtlst)
         (assoc 72 txtlst)
         (assoc 11 txtlst)
         (assoc 210 txtlst)
         '(100 . "AcDbAttributeDefinition")
         '(3 . "Prompt")
         '(2 . "TAG")
         '(70 . 8)
     );end list
    );end setq
    (entmake attlst)
   );end progn
  );end if
  (princ)
);end defun TXT2ATT

;;;----------------------------

(defun col2str (inp)
  (cond
    ((= inp nil)(setq ret "BYLAYER"))
    ((= inp 256)(setq ret "BYLAYER"))
    ((= inp 0)(setq ret "BYBLOCK"))
    ((and (> inp 0)(< inp 255))(setq ret (itoa inp)))
    (t nil)
  )
)

(defun savprop ()
  (setq clayer (getvar "CLAYER"))
  (setq cecolor (getvar "CECOLOR"))
  (setvar "CECOLOR" "BYLAYER")
  (setq celtype (getvar "CELTYPE"))
  (setvar "CELTYPE" "BYLAYER")
  (setq thickness (getvar "THICKNESS"))
  (setvar "THICKNESS" 0)
  (if (>= (atoi (getvar "ACADVER")) 13)
    (progn
      (setq celtscale (getvar "CELTSCALE"))
      (setvar "CELTSCALE" 1.0)
    )
  )
)

(defun resprop ()
  (if (>= (atoi (getvar "ACADVER")) 13)
    (setvar "CELTSCALE" celtscale)
  )
  (setvar "THICKNESS" thickness)
  (setvar "CELTYPE" celtype)
  (setvar "CECOLOR" cecolor)
  (setvar "CLAYER" clayer)
)

(defun textrect (tent / ang sinrot cosrot t1 t2 p1 p2 p3 p4)
  (setq p0 (cdr (assoc 10 tent))
    ang (cdr (assoc 50 tent))
    sinrot (sin ang)
    cosrot (cos ang)
    t1 (car (textbox tent))
    t2 (cadr (textbox tent))
    p1 (list (+ (car p0)
       (- (* (car t1) cosrot) (* (cadr t1) sinrot)))
       (+ (cadr p0)
       (+ (* (car t1) sinrot) (* (cadr t1) cosrot))))
    p2 (list (+ (car p0)
       (- (* (car t2) cosrot) (* (cadr t1) sinrot)))
       (+ (cadr p0)
       (+ (* (car t2) sinrot) (* (cadr t1) cosrot))))
    p3 (list (+ (car p0)
       (- (* (car t2) cosrot) (* (cadr t2) sinrot)))
       (+ (cadr p0)
       (+ (* (car t2) sinrot) (* (cadr t2) cosrot))))
    p4 (list (+ (car p0)
       (- (* (car t1) cosrot) (* (cadr t2) sinrot)))
       (+ (cadr p0)
       (+ (* (car t1) sinrot) (* (cadr t2) cosrot))))
  )
  (list p1 p2 p3 p4)
)

(defun T2M ( / mwid dset ibrk bitm bent sset rect mlay mcol mlst
                      bins bang tang nins num ndis chnd cent nhnd nstr
                      str pt1 pt2 pt3 dis dvx dvy dvz new)
  (if (< (atoi (getvar "ACADVER")) 13)
    (alert "This Function Requires\nRelease 13 or Higher")
    (progn
      (setq cmdecho (getvar "CMDECHO"))
      (setvar "CMDECHO" 0)
      (command "_.UNDO" "_G")
      (setq mwid 0.0)
      (setq dset (ssadd))
      ;
      (initget "Y N")
      (setq tmp (getkword "\nDS> Include Line Breaks <Y>/N: "))
      (if (/= tmp "N")(setq ibrk "Y")(setq ibrk "N"))
      ;
      (setq bitm (car (entsel "\nDS> Pick Base String: ")))
      (setq bent (entget bitm))
      (setq rect (textrect bent))
      (setq chk (distance (car rect)(cadr rect)))
      (if (> chk mwid)(setq mwid chk))
      ;
      (if (= "TEXT" (cdr (assoc 0 bent))) 
        (progn
          (redraw bitm 3)
          (princ "\nDS> Select Remaining Text: ")
          (setq sset (ssget '((0 . "TEXT"))))
          (if sset
            (progn
              (setq rect (textrect bent))
              (setq orig rect)
              (setq mlay (cdr (assoc 8 bent)))
              (setq mcol (cdr (assoc 62 bent)))
              (setq mlst (list (cdr (assoc 1 bent))))
              ;
              (if (> (cdr (assoc 72 bent)) 0)
                (setq bins (cdr (assoc 11 bent)))
                (setq bins (cdr (assoc 10 bent)))
              )
              (setq bang (cdr (assoc 50 bent)))
              (setq tang (- bang (/ PI 2)))
              (setq nins bins)
              (ssdel bitm sset)
              (while (> (sslength sset) 0)
                (setq num (sslength sset) itm 0)
                (setq ndis 99999999.9)
                (while (< itm num)
                  (setq chnd (ssname sset itm))
                  (setq cent (entget chnd))
                  (if (> (cdr (assoc 72 cent)) 0)
                    (setq cins (cdr (assoc 11 cent)))
                    (setq cins (cdr (assoc 10 cent)))
                  )
                  (setq cdis (distance bins cins))
                  (if (< cdis ndis)
                    (setq ndis cdis nhnd chnd nent cent)
                  )
                  (setq itm (1+ itm))
                )
                (setq dset (ssadd nhnd dset))
                (ssdel nhnd sset)
                ;
                (setq rect (textrect nent))
                (setq chk (distance (car rect)(cadr rect)))
                (if (> chk mwid)(setq mwid chk))
                ;
                (setq nstr (cdr (assoc 1 nent)))
                (setq mlst (append mlst (list nstr)))
              )
              ;
              (entdel bitm)
              (setq num (sslength dset) itm 0)
              (while (< itm num)
                (setq hnd (ssname dset itm))
                (entdel hnd)
                (setq itm (1+ itm))
              )
              ;
              (savprop)
              (setvar "CLAYER" mlay)
              (if (/= mcol nil)
                (setvar "CECOLOR" (col2str mcol))
              )
              (setq mwid (+ mwid (* mwid 0.025)))
              (setq pt1 (car orig))
              (setq pt2 (cadr orig))
              (setq dis (distance pt1 pt2))
              (setq dvx (/ (- (car pt2)(car pt1)) dis))
              (setq dvy (/ (- (cadr pt2)(cadr pt1)) dis))
              (setq pt3 (list dvx dvy 0.0))
              (setq nins (list (car (cadddr orig))
                         (cadr (cadddr orig))
                         (nth 2 (cdr (assoc 10 bent)))))
              ;
              (setq new '((0 . "MTEXT")(100 . "AcDbEntity")(100 . "AcDbMText")))
              (setq new (append new (list (assoc 7 bent))))
              (setq new (append new (list (assoc 8 bent))))
              (setq new (append new (list (cons 10 nins))))
              (setq new (append new (list (cons 11 pt3))))
              (foreach lin mlst
                (if (= ibrk "Y")
                  (if (/= lin (last mlst))
                    (setq lin (strcat lin "\\P"))
                  )
                  (setq lin (strcat lin " "))
                )
                (setq new (append new (list (cons 1 lin))))
              )
              (setq new (append new (list (assoc 40 bent))))
              (setq new (append new (list (cons 41 mwid))))
              (setq new (append new (list (cons 71 1))))
              (setq new (append new (list (cons 72 1))))
              (entmake new)
              (resprop)
              ;
              (setq sset nil)
              (setq dset nil)
              (setq lst nil)
              (command "_.UNDO" "_E")
              (setvar "CMDECHO" cmdecho)
            )
            (redraw bitm 4)
          )
        )
      )
    )
  )
  (setq sset nil)
  (setq mlst nil)
  (princ)
)

;;;-----------------------------------

(defun txtwidth (/ nent e ne twdth tdist ndist nwdth curerr)
	(setq currer *error*)
	(defun *error* (msg)
		(setq *error* curerr)
		(princ "\nAttwidth error")
		(princ)
	)
	(setq nent (nentsel "\nSelect text to edit"))
	(setq ne(entget (car nent)))
	(while(not(equal (cdr (assoc 0 ne)) "TEXT"))
		(princ "\nEntity selected is not text")
		(setq nent (nentsel "\nSelect attribute to edit"))
		(setq ne(entget (car nent)))
	)
	(setq twdth(cdr(assoc 41 ne)))
	(setq tdist(caadr(textbox ne)))
	(setq ndist(distance (cdr(assoc 10 ne))(getpoint (cdr(assoc 10 ne)) "\nEnter new width")))
	(setq nwdth(* ndist(/ twdth tdist)))
	(entmod(subst(cons 41 nwdth)(assoc 41 ne)ne))
	(setq curerr *error*)
	(princ)
)
	
;;;----------------

(defun attwidth (/ nent e ne twdth tdist ndist nwdth curerr)
	(setq currer *error*)
	(defun *error* (msg)
		(setq *error* curerr)
		(princ "\nAttwidth error")
		(princ)
	)
	(setq nent (nentsel "\nSelect attribute to edit"))
	(setq ne(entget (car nent)))
	(while(not(equal (cdr (assoc 0 ne)) "ATTRIB"))
		(princ "\nEntity selected is not an attribute")
		(setq nent (nentsel "\nSelect attribute to edit"))
		(setq ne(entget (car nent)))
	)
	(setq e(cdr(assoc 330 ne)))
	(setq twdth(cdr(assoc 41 ne)))
	(setq tdist(caadr(textbox ne)))
	(setq ndist(distance (cdr(assoc 10 ne))(getpoint (cdr(assoc 10 ne)) "\nEnter new width")))
	(setq nwdth(* ndist(/ twdth tdist)))
	(entmod(subst(cons 41 nwdth)(assoc 41 ne)ne))
	(entupd e)
	(setq curerr *error*)
	(princ)
)

;;;------------------------