;;---------------------=={  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 p
			old_selectioncycling

					    ;; -={ 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 r )
	(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)))
			)
	)
	(setq old_selectioncycling (getvar "selectioncycling"))
	(if old_selectioncycling (setvar "selectioncycling" 0))

	(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 / e )
										(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 lLst lHgt doc elst )
	(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)
