Getting rid of text formatting of mtext

[arman88]

I want to iterate through the mtexts of a given drawing and export them to Excel.suppose that there is an mtext in the drawing named mtextobj in which "sample" is written in the first line and "note" is written in the 2nd.this would be read as "sample note". i use textstring property:

.

.

Dim mtextobj As AcadMText

MsgBox mtextobj .TextString

.

.

and autocad returns "sample\Pnote". this is appropriate for me.

the problem is when text formatting of this mtext is changed.for example if i double click on the mtext and in the Text Formatting box change the color to red,autocad returns

{\C1;sample\Pnote}

 

or if i change the font to verdana it gives

{\fVerdana|b0|i0|c0|p34;sample\fVerdana|b0|i0|c178|p34;\P\fVerdana|b0|i0|c0|p34;note}

 

How can i access to the real content inside the mtext? and exclude text formatting data which is merged with the string.

any help is highly appreciated..

[mahahaavaaha]

Hi,

 

I don't think you have any other method than ging through the textstrings and individually stripping the controlcharacters. Take a look at the ExpressTools Uppercase Text-tool-lisp, you'll see that's the way Autodesk does it as well.

File tcaseSup.lsp, this is the part where they strip the formatting:

(defun acet-mtext-format-extract ( str / lst raw len pos frmt flst a n j lst2 )

(setq lst (list "{"    "}"    "\\P"    "\\~"
                "\\{"    "\\}"    "\\O"    "\\L"
                "\\S"    "\\A1"    "\\A2"    "\\A3"
                "\\f"    "\\C"    "\\H"    "\\T"
                "\\Q"    "\\W" "\\p"
          );list
      raw ""
      len (strlen str)
      pos 0
);setq

(while (> (strlen str) 0)
 
 (setq lst2 (mapcar '(lambda (x) (acet-str-find x str)) lst)
       lst2 (mapcar '(lambda (x) (if x (list x) x)) lst2)
       lst2 (apply 'append lst2)
          j (apply 'min lst2)
 );setq 
 (if (/= j 0)
     (progn
       (setq  raw (strcat raw 
                          (substr str 1 (- j 1))
                  )
              str (substr str j)
                a (acet-mtext-format-bite str) ;; (list format str offset)
             frmt (car a)
              str (cadr a)
                n (+ pos j)
              pos (+ pos 
                     j 
                     (caddr a)
                     (- (strlen frmt) 1)
                  )
             frmt (list frmt n)
             flst (cons frmt flst)
       );setq
       (setq n (+ (length lst) 10));get out of inner loop
     );progn
     (setq raw (strcat raw str)
           str ""
     );setq then get out
 );if    

);while

(list raw (reverse flst))
);defun acet-mtext-format-extract

 

/Petri

[cganiere]

I usually just explode the mtext. Use match properties to the format I want then recombine the text entities.

[arman88]

Hi Petri(mahahaavaaha)

Do those codes strip the textformatting? would you please let me know how can i use it. I am not that familiar with lisps.

I copied them into a blank notepad and saved it as tcaseSup.lsp. then in acad

Tools>AutoLISP>Load Application i loaded tcaseSup.lsp. then i wrote tcaseSup in the prompt and pressed Enter. but acad returned and error: "Unknown command "TCASESUP". Press F1 for help."

Was it the correct way?

[Hedgehog]

I use one called stripmtext.lsp but I suspect it does essentially the same thing...

stripmtext[308].lsp

[arman88]

I use one called stripmtext.lsp but I suspect it does essentially the same thing...

 

I tested that in the same way. autocad gave me an error:

"cannot load DCL file stripmtext[3].dcl"

 

In the file it is said that for AutoCAD 2000 thru 2004.mine is 2007.

thanks anyway

 

I am trying to find a VBA code for that

[Hedgehog]

Apologies... won't let me upload a DCL... erm, try this zip of it... I've run it on 2006/7/8

stripmtext[3].zip

[arman88]

Apologies... won't let me upload a DCL... erm, try this zip of it... I've run it on 2006/7/8

 

how should i run it? it still returns the same error. should i copy the DCL file to a special path? or load it manually in acad?

[CAB]

There is a newer version.

;|

StripMtext 4 BETA
Main function that performs the format removal written by John Uhden
All other supporting code and user interface written by Steve Doman

-------------------------------------------------------------------

Notes for Beta 4A 7/18/2005:

1) New file names are: StripMtext[4a].lsp & StripMtext[4].dcl
2) Added support for Acad Tables.
3) Fields inside Mtext objects seem to process ok, but need more testing.
4) Currently working on Tab removal.  DCL shows Tabs, but it doesn't work yet.
5) The report which prints a count of objects processed is temporarily disabled.
6) Please email bug reports, comments, or annoyances to: sdoman@qwest.net
7) Should I add support for the new fangled ArcLength Dimensions?

|;

[Hedgehog]

how should i run it? it still returns the same error. should i copy the DCL file to a special path? or load it manually in acad?

Bung 'em both in your support directory then appload the .lsp in Autocad... use stripmtext to run

[arman88]

Bung 'em both in your support directory then appload the .lsp in Autocad... use stripmtext to run

Dear Hedgehog Thanks. I got it . it works very well. :wink:

My source path was a little bit far:

C:\Documents and Settings\Administrator\Application Data\Autodesk\AutoCAD 2007\R17.0\enu\Support

 

I found VBA codes for stripping mtexts too,and will put it here soon.

 

By the way fantastic photogallery found in ur signature dude !

[arman88]

Option Explicit
' written by Bryco

Function UnformatMtext(S As String) As String

Dim P1 As Integer
Dim P2 As Integer, P3 As Integer
Dim intStart As Integer
Dim strCom As String
Dim strReplace As String

Debug.Print S

Select Case Left(S, 4)
Case "\A0;", "\A1;", "\A2;"
S = Mid(S, P1 + 5)
End Select
intStart = 1
Do
P1 = InStr(S, "%%")
If P1 = 0 Then
Exit Do
Else
Select Case Mid(S, P1 + 2, 1)
Case "P"
S = Replace(S, "%%P", "+or-")
Case "D"
S = Replace(S, "%%D", " deg")
End Select
End If
Loop

Do
P1 = InStr(intStart, S, "\", vbTextCompare)
If P1 = 0 Then Exit Do
strCom = Mid(S, P1, 2)
Select Case strCom
Case "\p"
P2 = InStr(1, S, ";")
S = Mid(S, P2 + 1)
Case "\A", "\C", "\f", "\F", "\H", "\Q", "\T", "\W"
P2 = InStr(P1 + 2, S, ";", vbTextCompare)
P3 = InStr(P1 + 2, S, strCom, vbTextCompare)
If P3 = 0 Then
S = Left(S, P1 - 1) & Mid(S, P2 + 1)
End If
Do While P3 > 0
P2 = InStr(P3, S, ";", vbTextCompare)
S = Left(S, P3 - 1) & Mid(S, P2 + 1)
'Debug.Print s, strCom
P3 = InStr(1, S, strCom, vbTextCompare)
Loop
's = Left(s, P3 - 1) & mid(s, P3 + 1)
'Case "\L", "\O"
'Dim strLittle As String
'strLittle = LCase(strCom)
'P2 = InStr(P1 + 2, S, strLittle, vbTextCompare)
'S = Left(S, P1 - 1) & Mid(S, P1 + 2, P2 - (P1 + 2)) & Mid(S, P2 + 2)
'//============== fixed by fla_2
'// example {\fArial|b1|i0|c0|p34;\LGENERAL NOTES :}
Case "\L", "\O"
Dim strLittle As String
strLittle = LCase(strCom)
P2 = InStr(P1 + 2, S, strLittle, vbTextCompare)
If P2 = 0 Then
S = Left(S, P1 - 1) & Mid(S, P1 + 2)
Else
S = Left(S, P1 - 1) & Mid(S, P1 + 2, P2 - (P1 + 2)) & Mid(S, P2 + 2)
End If
'//==============
Case "\S"
P2 = InStr(P1 + 2, S, ";", vbTextCompare)
P3 = InStr(P1 + 2, S, "/", vbTextCompare)
If P3 = 0 Or P3 > P2 Then
P3 = InStr(P1 + 2, S, "#", vbTextCompare)
End If
If P3 = 0 Or P3 > P2 Then
P3 = InStr(P1 + 2, S, "^", vbTextCompare)
End If
S = Left(S, P1 - 1) & Mid(S, P1 + 2, P3 - (P1 + 2)) _
& "/" & Mid(S, P3 + 1, (P2) - (P3 + 1)) & Mid(S, P2 + 1)

Case "\U"
strLittle = Mid(S, P1 + 3, 4)
Debug.Print strLittle
Select Case strLittle
Case "2248"
strReplace = "ALMOST EQUAL"
Case "2220"
strReplace = "ANGLE"
Case "2104"
strReplace = "CENTER LINE"
Case "0394"
strReplace = "DELTA"
Case "0278"
strReplace = "ELECTRIC PHASE"
Case "E101"
strReplace = "FLOW LINE"
Case "2261"
strReplace = "IDENTITY"
Case "E200"
strReplace = "INITIAL LENGTH"
Case "E102"
strReplace = "MONUMENT LINE"
Case "2260"
strReplace = "NOT EQUAL"
Case "2126"
strReplace = "OHM"
Case "03A9"
strReplace = "OMEGA"
Case "214A"
strReplace = "PROPERTY LINE"
Case "2082"
strReplace = "SUBSCRIPT2"
Case "00B2"
strReplace = "SQUARED"
Case "00B3"
strReplace = "CUBED"

End Select
S = Replace(S, "\U+" & strLittle, strReplace)

Case "\~"
S = Replace(S, "\~", " ")

Case "\\"
intStart = P1 + 2
S = Replace(S, "\\", "\")
GoTo Selectagain

Case "\P"
intStart = P1 + 1
GoTo Selectagain
Case Else
Exit Do
End Select
Selectagain:
Loop

Do
P1 = InStr(1, S, "\P", vbTextCompare)
If P1 = 0 Then
Exit Do
Else
S = Left(S, P1 - 1) & vbCrLf & Mid(S, P1 + 2)
End If
Loop
For intStart = 0 To 1
If intStart = 0 Then
strCom = "}"
Else
strCom = "{"
End If
P2 = InStr(1, S, strCom)

Do While P2 > 0
S = Left(S, P2 - 1) & Mid(S, P2 + 1)
P2 = InStr(1, S, strCom)
Loop
Next intStart


UnformatMtext = S

End Function

Sub Testmt()
Dim Mt As AcadMText, V As Variant
ThisDrawing.Utility.GetEntity Mt, V, "Pick an Mtext:"
MsgBox Mt.TextString
Debug.Print Mt.TextString
MsgBox Mt.TextString
Mt.TextString = UnformatMtext(Mt.TextString)
MsgBox Mt.TextString
End Sub

[Hedgehog]

Dear Hedgehog Thanks. I got it . it works very well. :wink:

My source path was a little bit far:

C:\Documents and Settings\Administrator\Application Data\Autodesk\AutoCAD 2007\R17.0\enu\Support

 

I found VBA codes for stripping mtexts too,and will put it here soon.

 

By the way fantastic photogallery found in ur signature dude !

Glad you were able to get it to work finally.... I usually check & double check that things work but I wasn't feeling too good yesterday...

 

... & thanks for clicking the link... photography is my other passion. :wink:

[Arizona]

Apologies... won't let me upload a DCL... erm, try this zip of it... I've run it on 2006/7/8

 

Sweet routine! It really helped me out with a bunch of Ustn conversion MText that was a MESS! That just saved me a day's work!

 

THANKS HEDGEHOG!!

[Hedgehog]

No wurries, glad it was helpful... & good the search facility is getting some use

[gpetty46]

This thread seems current, so I'll ask here.

 

Ran StripMtext[309].lsp several time last week and it worked perfectly.

Today I get an error msg:

STRIPMTEXT

StripMtext v3.09

Select objects: 1 found

 

Select objects:

Error: Automation Error. No database

 

Any idea what this means?

Thanks in advance,

Gary

[Hedgehog]

Try adding a 2nd piece of new mtext?... does it still happen?... does it happen in other drawings?... probably a programming error rather than something to do with your set-up.

[CAB]

You may try my Stripper to see it it gets an error.

See attached.

Usage (strip_text MyString '*') to strip ALL

Text Strip CAB30.LSP

[gpetty46]

Hedgehog - Yeah, does same thing in any drawing. FYI I'm importing text from a PDF that places the formatting codes in there.

 

CAB - Your STRIPPER does the same thing.?!

 

Which leads me to believe it's an installation problem. This IS a new install of AutoCAD2008 and I DID do a registry clean the other day, so......

I'll do an uninstall and reinstall of AutoCAD and see what happens.

 

Thanks for trying to help. I'll let you know what happens.

 

Gary

[Hedgehog]

But is it only happening on the PDF imported text?... it may just be coming across a code in that which it can't handle.