;;---------------------=={  Text 2 MText Upgraded  }==---------------------------;;
;;                                                                               ;;
;;  Similar to the Txt2MTxt Express Tools function, but allows the user          ;;
;;  additional control over where the text is placed in the resultant MText.     ;;
;;                                                                               ;;
;;  The user can pick MText or DText, positioning such text using one of two     ;;
;;  modes: "New Line" or "Same Line". The Modes can be switched by pressing      ;;
;;  Space between picks.                                                         ;;
;;                                                                               ;;
;;  The user can also hold shift and pick text to keep the original text in      ;;
;;  place, and press "u" between picks to undo the last text pick.               ;;
;;                                                                               ;;
;;-------------------------------------------------------------------------------;;
;;                                                                               ;;
;;  FUNCTION SYNTAX:  T2M                                                        ;;
;;                                                                               ;;
;;  Notes:-                                                                      ;;
;;  --------                                                                     ;;
;;  Shift-click functionality requires the user to have Express Tools installed. ;;
;;                                                                               ;;
;;-------------------------------------------------------------------------------;;
;;                                                                               ;;
;;  Author: Lee Mac, Copyright © September 2009 - www.lee-mac.com                ;;
;;                                                                               ;;
;;-------------------------------------------------------------------------------;;
;;                                                                               ;;
;;  Version:                                                                     ;;
;;                                                                               ;;
;;  1.0:  27/09/2009  -  First Release                                           ;;
;;-------------------------------------------------------------------------------;;
;;  1.1:  29/09/2009  -  Minor Bug Fixes                                         ;;
;;-------------------------------------------------------------------------------;;
;;  1.2:  29/09/2009  -  Fixed Alignment Bug                                     ;;
;;                    -  Added Code to match Height                              ;;
;;-------------------------------------------------------------------------------;;
;;  1.3:  01/10/2009  -  Added option to Copy Text.                              ;;
;;-------------------------------------------------------------------------------;;
;;  1.4:  01/10/2009  -  Added option to Undo Last text selection                ;;
;;-------------------------------------------------------------------------------;;
;;  1.5:  30/03/2010  -  Modified code to allow for mis-click.                   ;;
;;                    -  Updated UndoMarks.                                      ;;
;;-------------------------------------------------------------------------------;;
;;  1.6:  15/04/2010  -  MText objects now have correct width.                   ;;
;;                    -  Accounted for %%U symbol.                               ;;
;;-------------------------------------------------------------------------------;;
;;  1.7:  16/04/2010  -  Fixed %%U bug.                                          ;;
;;                    -  Trimmed Spaces when in 'Same Line' mode.                ;;
;;                    -  Fixed Width when Undo is used.                          ;;
;;                    -  Allowed Shift-Click to keep first text object selected. ;;
;;-------------------------------------------------------------------------------;;
;;  1.8:  10/05/2010  -  Allowed for UCS variations.                             ;;
;;                    -  Matched initial text rotation.                          ;;
;;-------------------------------------------------------------------------------;;
;;  1.9:  21/05/2010  -  Added ability to use SelectionSet to select text.       ;;
;;-------------------------------------------------------------------------------;;
;;  2.0:  07/06/2010  -  Fixed offset from cursor with rotated text.             ;;
;;-------------------------------------------------------------------------------;;

(defun c:lm_Text2MText (/
			;; -={ Local Functions }=-
			*error*	  align_mt  get_mtoffset_pt
			gettextwidth	    replaceunderline
			;; -={ local variables }=-
			code	  data	    doc	      elst
			ent	  et	    formflag  grdata
			lhgt	  llst	    mlst      msg
			nobj	  nstr	    obj	      shft
			spc	  tent	    tobj      textss
			uflag	  under	    wlst
					    ;; -={ Global Variables }=-
					; *T2M_mode*  ~  Mode for line addition
		       )
  (mai_last_com "lm_Text2MText")

					;     --=={ Sub Functions  }==--      ;

  ;; -={ Error Handler }=-

  (defun *error* (err)
    (and uFlag (vla-EndUndoMark doc))
    (and tObj (not (vlax-erased-p tObj)) (vla-delete tObj))
    (if	eLst
      (mapcar 'entdel (vl-remove-if 'null eLst))
    )
    (or	(wcmatch (strcase err) "*BREAK,*CANCEL*,*EXIT*")
	(princ (strcat "\n** ³ö´í: " err " **"))
    )
    (princ)
  )


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


  (defun align_Mt (obj / al)
    (setq al (vla-get-ObjectName obj))
    (cond ((eq "AcDbMText" al) (vla-get-AttachmentPoint obj))
	      ((eq "AcDbText"al)
	       (setq al (vla-get-Alignment obj))
	       (cond ((<= 0 al 2) (1+ al))
		         ((<= 3 al 5) 1)
		         ((- al 5))
	       )
	      )
    )
  )


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


  (defun Get_MTOffset_pt (obj pt / miP maP al h)
    (vla-getBoundingBox obj 'miP 'maP)
    (setq miP (vlax-safearray->list miP)
	  maP (vlax-safearray->list maP)
	  al  (vla-get-AttachmentPoint obj)
	  r   (- (vla-get-rotation obj) (/ pi 2.))
	  h   (vla-get-Height obj)
	  mip (- (cadr maP) (cadr miP))
    )
    (cond ((or (eq acAttachmentPointTopLeft al)
	       (eq acAttachmentPointTopCenter al)
	       (eq acAttachmentPointTopRight al)
	   )
	   (polar pt r h)
	  )
	  ((or (eq acAttachmentPointMiddleLeft al)
	       (eq acAttachmentPointMiddleCenter al)
	       (eq acAttachmentPointMiddleRight al)
	   )
	   (polar pt r (+ h (/ mip 2.)))
	  )
	  ((or (eq acAttachmentPointBottomLeft al)
	       (eq acAttachmentPointBottomCenter al)
	       (eq acAttachmentPointBottomRight al)
	   )
	   (polar pt r (+ h mip))
	  )
    )
  )


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


  (defun GetTextWidth (obj / tBox eLst)
    (cond ((eq "AcDbText" (vla-get-objectname obj))
	   (setq eLst (entget (vlax-vla-object->ename obj))
		 tBox (assoc 1 eLst)
		 tBox (textbox
			(subst (cons 1 (strcat "..." (cdr tbox))) tbox eLst)
		      )
	   )
	   (- (caadr tBox) (caar tBox))
	  )
	  ((vla-get-Width obj))
    )
  )


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


  (defun ReplaceUnderline (str / i under)
    (if	(vl-string-search "%%U" (strcase Str))
      (progn
	(while (and (< i (strlen Str))
		    (setq i (vl-string-search "%%U" (strcase Str) i))
	       )
	  (setq	Str   (strcat (substr Str 1 i)
			      (if under
				"\\l"
				"\\L"
			      )
			      (substr Str (+ i 4))
		      )
		i     (+ i 4)
		under (not under)
	  )
	)

	(if under
	  (setq str (strcat str "\\l"))
	)
      )
    )
    str
  )


					;     --=={ Main Function  }==--


  (setq	doc (vla-get-ActiveDocument
	      (vlax-get-acad-object)
	    )
	spc (if	(or (eq AcModelSpace (vla-get-activespace doc))
		    (eq :vlax-true (vla-get-MSpace doc))
		)

	      (vla-get-modelspace doc)
	      (vla-get-paperspace doc)
	    )
	Et  (and (vl-position "acetutil.arx" (arx))
		 (not (vl-catch-all-error-p
			(vl-catch-all-apply 'acet-sys-shift-down)
		      )
		 )
	    )
  )

  (or *T2M_Mode* (setq *T2M_Mode* 0))
  (setq mLst '("¡¾·ÅÐÂÒ»ÐÐ¡¿" "¡¾·ÅÍ¬Ò»ÐÐ¡¿"))

  (while
    (progn
      (setq
	ent (car
	      (entsel
		"\nµ¥Ñ¡µ¥ÐÐÎÄ×Ö»ò¶àÐÐÎÄ×Ö [×ó¼üÖØÑ¡¶àÐÐÎÄ×Ö¿òµÄ´óÐ¡]:"
	      )
	    )
      )
      (and et (setq shft (acet-sys-shift-down)))
      (cond ((not ent) (princ "\n** Ã»ÓÐÑ¡ÔñÈÎºÎÊµÌå **"))
	    ((not (wcmatch (mai_dxf 0 ent) "*TEXT"))
	     (princ "\n** Ñ¡ÔñµÄÊµÌå²»ÊÇÎÄ×Ö **")
	    )
      )
    )
  )

  (setq	uFlag (not (vla-StartUndoMark doc))
	obj   (vlax-ename->vla-object ent)
	tObj  (vla-AddMText
		spc
		(vla-get-InsertionPoint obj)
		(GetTextWidth obj)
		(ReplaceUnderline (vla-get-TextString obj))
	      )
  )


  (foreach p '(InsertionPoint Layer Color StyleName Height)
    (vlax-put tObj p (vlax-get obj p))
  )






  (vla-put-rotation
    tObj
    (if	(eq "AcDbText" (vla-get-ObjectName obj))
      (- (vla-get-rotation obj)


	 (angle	'(0. 0. 0.)
		(trans (getvar 'UCSXDIR) 0 (trans '(0. 0. 1.) 1 0 t))
	 )
      )
      (vla-get-rotation obj)
    )
  )

  (vla-put-AttachmentPoint tObj (align_Mt obj))

  (or (and shft (setq eLst (cons nil eLst)))
      (and (entdel ent) (setq eLst (cons ent eLst)))
  )

  (princ (eval (setq msg
		      '(strcat
			"\n~   µ±Ç°Ôö¼ÓÎÄ×ÖÄ£Ê½: "
			(nth *T2M_mode* mLst)
			" ~[°´¿Õ¸ñ¼üÇÐ»»]"
			"\n~¤~ Ñ¡ÔñÒª×ª»»µÄÎÄ×Ö [×ó¼üÖØÑ¡¶àÐÐÎÄ×Ö¿òµÄ´óÐ¡] [³·Ïú(Undo)] <»Ø³µÈ·¶¨¶àÐÐÎÄ×ÖÎ»ÖÃ> ~"
		       )
	       )
	 )
  )

  (while
    (progn
      (setq grdata (grread 't 15 2)
	    code   (car grdata)
	    data   (cadr grdata)
      )

      (cond
	((and (= 5 code) (listp data))
	 (vla-put-InsertionPoint
	   tObj
	   (vlax-3D-point
	     (Get_MTOffset_pt tObj (trans data 1 0))
	   )
	 )
	 t
	)

	((and (= 3 code) (listp data))
	 (if (and (setq tEnt (car (nentselp data)))
		  (wcmatch (mai_dxf 0 tEnt) "*TEXT")
	     )
	   (AddtoMTextSelection tEnt)

	   (progn
	     (vla-put-Visible tObj :vlax-false)
	     (if (setq textss (GetSelectionSet
				"\nÊäÈë½Çµã :"
				data
				'((0 . "TEXT,MTEXT"))
			      )
		 )
	       (
		(lambda	(i)
		  (while (setq i (1+ i)
			       e (ssname textss i)
			 )
		    (AddtoMTextSelection e)
		  )
		  (princ (eval msg))
		)
		 -1
	       )
	       (princ (strcat "\n** Ã»ÓÐÑ¡Ôñµ½ÎÄ×Ö **" (eval msg)))
	     )
	     (vla-put-Visible tObj :vlax-true)
	     t
	   )
	 )
	)

	((= 25 code) nil)

	((= 12 code) nil)
	((= 2 code)

	 (cond ((= 13 data) nil)
	       ((= 32 data)
		(setq *T2M_mode* (- 1 *T2M_mode*))
		(princ (eval msg))
	       )

	       ((vl-position data '(85 117))

		(if (< 1 (length eLst))
		  (progn

		    (vla-put-TextString
		      tObj
		      (substr (vla-get-TextString tObj) 1 (car lLst))
		    )

		    (vla-put-Width tObj (car wLst))

		    (if	(car eLst)
		      (entdel (car eLst))
		    )
		    (setq eLst (cdr eLst)
			  lLst (cdr lLst)
			  wLst (cdr wLst)
		    )
		    t
		  )

		  (progn (princ "\n** Ã»ÓÐ¶¯×÷¿É³·Ïú **")
			 (princ (eval msg))
		  )
		)
	       )

	       (t)
	 )
	)

	(t)
      )
    )
  )

  (setq uFlag (vla-EndUndoMark doc))
  (princ)
)

(defun AddtoMTextSelection (tEnt / nStr nObj formflag n1 t1)
  (setq	lLst	 (cons (strlen (vla-get-TextString tObj)) lLst)
	t1	(vla-get-Width tObj)
	wLst	 (cons t1 wLst)
	nObj	 (vlax-ename->vla-object tEnt)
	nStr	 (vla-get-TextString nObj)
	formflag nil
  )

  (vla-put-Width
    tObj
    ((if (= *T2M_mode* 1)
       +
       max
     )
      (vla-get-Width tObj)
      (GetTextWidth nObj)
    )
  )

  (setq	n1 (vla-get-Color nObj)
	t1 (vla-get-Color tObj)
  )
  (or (eq n1 t1)
      (vl-position n1 '(255 0))
      (setq nStr     (strcat "\\C" (itoa n1) ";" nStr)
	    formflag t
      )
  )

  (setq	nStr (ReplaceUnderline nStr)
	    n1   (vla-get-Height nObj)
	    t1   (vla-get-Height tObj)
  )

  (or (eq n1 t1)
      (and lHgt (eq n1 lHgt))
      (setq nStr     (strcat "\\H"
			     (rtos (/ (float n1)
				      (cond (lHgt)
					    (t1)
				      )
				   )
				   2
				   2
			     )
			     "x;"
			     nStr
		     )
	    lHgt     n1
	    formflag t
      )
  )

  (setq n1   (vla-get-StyleName nObj)
	    t1   (vla-get-StyleName tObj)
  )
 (if (not (eq n1 t1))
    (setq nStr
	   (strcat "\\F"
		   (vla-get-fontfile (vla-item (vla-get-TextStyles doc) n1))
		   ";"
		   nStr
	   )
	  formflag t
    )
  )

  (if formflag
    (setq nStr (strcat "{" nStr "}"))
  )

  (vla-put-TextString
    tObj
    (strcat
      (vla-get-TextString tObj)
      (if (zerop *T2M_mode*)
	(strcat "\\P" nStr)
	(strcat " " (vl-string-left-trim (chr 32) nStr))
      )
    )
  )

  (vla-update tObj)
  (or (and et
	   (acet-sys-shift-down)
	   (setq eLst (cons nil eLst))
      )
      (and (entdel tEnt)
	   (setq eLst (cons tEnt eLst))
      )
  )
  t
)


(defun GetSelectionSet (str pt filter / gr data pt1 pt2 lst)
  (princ str)
  (while (and (= 5 (car (setq gr (grread t 13 0))))
	      (listp (setq data (cadr gr)))
	 )
    (redraw)
    (setq pt1 (list (car data) (cadr pt) (caddr data))
	  pt2 (list (car pt) (cadr data) (caddr data))
    )
    (grvecs
      (setq lst
	     (list
	       (if (minusp (- (car data) (car pt)))
		 -30
		 30
	       )
	       pt
	       pt1
	       pt
	       pt2
	       pt1
	       data
	       pt2
	       data
	     )
      )
    )
  )

  (redraw)

  (ssget (if (minusp (car lst))
	   "_C"
	   "_W"
	 )
	 pt
	 data
	 filter
  )
)

(princ)