;;;ЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,;;;
;;;ј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,ЄКА`АКЄ;;;
;;                                                                               ;;
;;                   --=={  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:                                                                      ;;
;;                                                                               ;;
;;  Copyright Љ Lee McDonnell, September 2009. All Rights Reserved.              ;;
;;                                                                               ;;
;;      { Contact: Lee Mac @ TheSwamp.org, CADTutor.net }                        ;;
;;                                                                               ;;
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;
;;                                                                               ;;
;;  VERSION:                                                                     ;;
;;                                                                               ;;
;;    ј 1.0   ~Є~   27th September 2009   ~Є~   К First Release                  ;;
;;...............................................................................;;
;;    ј 1.1   ~Є~   29th September 2009   ~Є~   К Minor Bug Fixes                ;;
;;...............................................................................;;
;;    ј 1.2   ~Є~   29th September 2009   ~Є~   К Fixed Alignment Bug            ;;
;;                                              К Added Code to match Height     ;;
;;...............................................................................;;
;;    ј 1.3   ~Є~      1st October 2009   ~Є~   К Added option to Copy Text.     ;;
;;...............................................................................;;
;;    ј 1.4   ~Є~      1st October 2009   ~Є~   К Added option to Undo Last text ;;
;;                                                Selection                      ;;
;;...............................................................................;;
;;    ј 1.5   ~Є~       30th March 2010   ~Є~   К Modified code to allow for     ;;
;;                                                mis-click.                     ;;
;;                                              К Updated UndoMarks.             ;;
;;...............................................................................;;
;;    ј 1.6   ~Є~       15th April 2010   ~Є~   К MText objects now have correct ;;
;;                                                width.                         ;;
;;                                              К Accounted for %%U symbol.      ;;
;;...............................................................................;;
;;    ј 1.7   ~Є~       16th April 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.    ;;
;;...............................................................................;;
;;                                                                               ;;
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;
;;                                                                               ;;
;;;ЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,;;;
;;;ј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,ЄКА`АКЄ;;;


(defun c:t2m ( /  ;; -={ 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
                  UFLAG UNDER
                  WLST
              
                  ;; -={ Global Variables }=-

                  ; *T2M_mode*  ~  Mode for line addition
)
  
  (vl-load-com)

;;;ЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,И

;     --=={ 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 (function entdel)
               (vl-remove-if (function null) eLst)))
    
    (or (wcmatch (strcase err) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " err " **")))
    (princ))

  (defun align_Mt (obj / al)
    (cond (  (eq "AcDbMText" (vla-get-ObjectName obj))
             (vla-get-AttachmentPoint obj))

          (  (eq "AcDbText" (vla-get-ObjectName obj))
             (setq al (vla-get-Alignment obj))

             (cond (  (<= 0 al 2) (1+ al))
                   (  (<= 3 al 5) 1)
                   (t (- al 5))))))  

  (defun Get_MTOffset_pt (obj pt / miP maP al)
    (vla-getBoundingBox obj 'miP 'maP)
    (setq miP (vlax-safearray->list miP)
          maP (vlax-safearray->list maP))

    (setq al (vla-get-AttachmentPoint obj))

    (cond (  (or (eq acAttachmentPointTopLeft   al)
                 (eq acAttachmentPointTopCenter al)
                 (eq acAttachmentPointTopRight  al))
           
             (polar pt (/ (* 3 pi) 2.) (vla-get-Height obj)))

          (  (or (eq acAttachmentPointMiddleLeft   al)
                 (eq acAttachmentPointMiddleCenter al)
                 (eq acAttachmentPointMiddleRight  al))
           
             (polar pt (/ (* 3 pi) 2.) (+ (vla-get-Height obj)
                                          (/ (- (cadr maP) (cadr miP)) 2.))))
  
          (  (or (eq acAttachmentPointBottomLeft   al)
                 (eq acAttachmentPointBottomCenter al)
                 (eq acAttachmentPointBottomRight  al))
           
             (polar pt (/ (* 3 pi) 2.) (+ (vla-get-Height obj)
                                          (- (cadr maP) (cadr miP)))))))

  (defun GetTextWidth (obj / tBox eLst)
    (cond (  (eq "AcDbText" (vla-get-objectname obj))

             (setq eLst (entget  (vlax-vla-object->ename obj))
                   tBox (textbox
                          (subst
                            (cons 1 (strcat "..." (cdr (assoc 1 eLst))))
                              (assoc 1 eLst) 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)))
          (if under
            (setq Str (strcat (substr Str 1 i) "\\l" (substr Str (+ i 4))) i (+ i 4) under nil)
            (setq Str (strcat (substr Str 1 i) "\\L" (substr Str (+ i 4))) i (+ i 4) under t  )))
        
        (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)))
  
  (setq Et
      (and (vl-position "acetutil.arx" (arx))
           (not
             (vl-catch-all-error-p
               (vl-catch-all-apply
                 (function (lambda nil (acet-sys-shift-down))))))))

  (or *T2M_Mode* (setq *T2M_Mode* 0))
  (setq mLst '("New Line " "Same Line"))

  (while
    (progn
      (setq ent (car (entsel "\nSelect Text/MText [Shift-Click keep original]: ")))
      (and et (setq shft (acet-sys-shift-down)))
      
      (cond (  (not ent)
               (princ "\n** Nothing Selected **"))
            
            (  (not (wcmatch (cdr (assoc 0 (entget ent))) "*TEXT"))
               (princ "\n** Object is not Text **")))))

  (setq uFlag (not (vla-StartUndoMark doc)))

  (setq tObj
    (vla-AddMText spc
      
      (vla-get-InsertionPoint
        (setq obj (vlax-ename->vla-object ent))) (GetTextWidth obj)
      
          (ReplaceUnderline (vla-get-TextString obj))))

  (foreach p '(InsertionPoint Layer Color StyleName Height)
    (vlax-put-property tObj p
      (vlax-get-property obj p)))
  
  (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~Є~  Current Mode: " (nth *T2M_mode* mLst) " ~Є~   [Space to Change]"
                                  "\n~Є~ Select Text to Convert [Shift-Click keep original] [Undo] <Place MText> ~Є~"))))

  (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 data))) t)

            (  (and (= 3 code) (listp data))

               (if (and (setq tEnt (car (nentselp data)))
                        (wcmatch (cdr (assoc 0 (entget tEnt))) "*TEXT"))
                 (progn
                   (setq lLst (cons (strlen (vla-get-TextString tObj)) lLst)
                         wLst (cons (vla-get-Width tObj) wLst))
                   
                   (setq nStr
                     (vla-get-TextString
                       (setq nObj
                         (vlax-ename->vla-object tEnt))) formflag nil)

                   (vla-put-Width tObj
                     ((if (= *T2M_mode* 1) + max)
                       (vla-get-Width tObj) (GetTextWidth nObj)))
                   
                   (if (not (or (eq (vla-get-Color nObj) (vla-get-Color tObj))
                                (vl-position (vla-get-Color nObj) '(255 0))))
                     
                     (setq nStr (strcat "\\C" (itoa (vla-get-Color nObj)) ";" nStr) formflag t))

                   (setq nStr (ReplaceUnderline nStr))

                   (if (not (or (eq (vla-get-Height nObj) (vla-get-Height tObj))
                                (and lHgt (eq (vla-get-Height nObj) lHgt))))
                     
                     (setq nStr (strcat "\\H" (rtos (/ (float (vla-get-Height nObj))
                                                       (cond (lHgt) ((vla-get-Height tObj)))) 2 2)  "x;" nStr)
                           lHgt (vla-get-Height nObj) formflag t))
                   
                   (if (not (eq (vla-get-StyleName nObj) (vla-get-StyleName tObj)))
                     (setq nStr
                       (strcat "\\F" (vla-get-fontfile
                                       (vla-item
                                         (vla-get-TextStyles doc)
                                           (vla-get-StyleName nObj))) ";" 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)

                 (princ (strcat "\n** No Text/MText Selected **" (eval msg)))))

            (  (= 25 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** Nothing to Undo **")
                            (princ (eval msg)))))                           
                            
                     (t )))

            (t ))))

  (setq uFlag (vla-EndUndoMark doc))
  (princ))

(princ "\nјЄКА`АКЄј  Text2MText.lsp ~ Copyright Љ by Lee McDonnell  јЄКА`АКЄј")
(princ "\n   ~Є~             ...Type \"T2M\" to Invoke...                ~Є~   ")
(princ)


;;;ЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,;;;
;;                                                                               ;;
;;                             End of Program Code                               ;;
;;                                                                               ;;
;;;ј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,јЄКА`АКЄј,ИИ,ЄКА`АКЄ;;;