View Full Version : Text 2 Mtext in 2008
gfreddog
2008-01-09, 04:55 PM
I have some code that I "borrowed" from this forum that works great in AutoCAD 2004.
But, now we're side-grading to AutoCAD MEP Suite 2008 and it stopped working.
The Code:
;;; Function: Convert Txt to MText
;;; Command Line: T2M
;;; Description: Converts a line of text to a mtext entity
;;;
(vl-load-com)
(defun C:T2M (/ Factor Style ss i Ename Elst Tspace Tstyle)
(setvar "tspacetype" 2)
(setvar "tspacefac" 1)
(command "txt2mtxt" (ssget) "")
(setq ss (ssget "_L"))
(if ss
(progn
(setq Style 2)
(setq Factor 1)
(setq heigt 0.1)
(setq txtfnt CRI)
(setq i -1)
(repeat (sslength ss)
(setq Ename (ssname ss (setq i (1+ i)))
Elst (entget Ename)
Tspace (cdr (assoc 44 Elst))
Tstyle (cdr (assoc 73 Elst)))
(setq Elst (subst (cons 44 Factor) (cons 44 Tspace) Elst))
(setq Elst (subst (cons 73 Style) (cons 73 Tstyle) Elst))
(entmod Elst)
)
)
)
(princ))
Any ideeas?
Thx;
kpblc2000
2008-01-09, 06:30 PM
Do you have Express Tools installed?
gfreddog
2008-01-09, 08:02 PM
Do you have Express Tools installed?
No, I don't think AutoCAD MEP Suite 2008 comes with it?
T.Willey
2008-01-09, 08:54 PM
(command "txt2mtxt" (ssget) "")
^ This is the call to an express tools command, as far as I know. You might have to write a custom one then. Here is one I wrote a while ago. I'm pretty sure it worked.
(defun c:Dt2Mt (/ ActDoc ss TxtList TxtLine CurSpace MtPt1 MtDist othm tmpObj LL UR MtObj MtHt MtLay MtRot)
; Converts dtext to mtext
; Sub's 'tmw:ss->Objlist 'tmw:Var->Safe 'GetCurrentSpace
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-StartUndoMark ActDoc)
(setq othm (vla-GetVariable ActDoc "orthomode"))
(vla-SetVariable ActDoc "orthomode" 1)
(if (setq ss (ssget '((0 . "TEXT"))))
(progn
(setq TxtList (tmw:ss->Objlist ss))
(setq TxtList
(vl-sort
TxtList
'(lambda (a b)
(>
(cadr (tmw:Var->Safe (vla-get-InsertionPoint a)))
(cadr (tmw:Var->Safe (vla-get-InsertionPoint b)))
)
)
)
)
(setq tmpObj (car TxtList))
(setq MtPt1 (tmw:Var->Safe (vla-get-InsertionPoint tmpObj)))
(vla-GetBoundingBox tmpObj 'LL 'UR)
(setq LL (safearray-value LL))
(setq UR (safearray-value UR))
(setq MtDist (abs (- (car UR) (car LL))))
(setq MtHt (vla-get-Height tmpObj))
(setq MtLay (vla-get-Layer tmpObj))
(setq MtRot (vla-get-Rotation tmpObj))
(foreach item TxtList
(if TxtLine
(setq TxtLine (strcat TxtLine " " (vla-get-TextString item)))
(setq TxtLine (vla-get-TextString item))
)
(vla-Delete item)
)
(setq CurSpace (GetCurrentSpace ActDoc))
(setq MtObj (vla-AddMText CurSpace (vlax-3d-point MtPt1) MtDist TxtLine))
(vla-put-Height MtObj MtHt)
(vla-put-Layer MtObj MtLay)
(vla-put-Rotation MtObj MtRot)
)
)
(vla-SetVariable ActDoc "orthomode" othm)
(vla-EndUndoMark ActDoc)
(princ)
)
(defun GetCurrentSpace (Doc / BlkCol SpaceList CurSpace ActSpace temp1)
; Returns the "block object" for the active space
; Thanks to Jeff Mishler
(if (= (getvar "cvport") 1)
(vla-get-PaperSpace Doc)
(vla-get-ModelSpace Doc)
)
)
(defun tmw:ss->Objlist (ss / RtnList temp1)
(while (setq temp1 (ssname ss 0))
(setq RtnList (cons (vlax-ename->vla-object temp1) RtnList))
(ssdel temp1 ss)
)
RtnList
)
(defun tmw:Var->Safe (VariantValue /)
(if (= (type VariantValue) 'variant)
(safearray-value (variant-value VariantValue))
)
)
gfreddog
2008-01-10, 03:01 PM
Very kewl that worked!!!! :lol:
Thanks for the help!
Have a :beer: or :beer::beer: on me
Stay safe;
T.Willey
2008-01-10, 03:59 PM
Glad it worked for you, you're welcome.
You can have my :beer: as I don't drink, but thanks for the offer. :lol:
gfreddog
2008-01-10, 06:34 PM
Glad it worked for you, you're welcome.
You can have my :beer: as I don't drink, but thanks for the offer. :lol:
LOL I don't either... we can just leave them on the forum and someone will drink them.... as long as no one puts their cigarettes out in them :p
I must be the only volunteer fireman that doesn't LOL :)
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.