Solved: converting text to mtext in autocad

[KennyJ]

I have this code from some website that will convert text to mtext in autocad. The only problem with it is after it converts the text it places the text in weird locations on the drawing sometimes just a little lower sometimes it the middle of the drawing i need it to place the Mtext in the exact position of the old text. Any ideas? Thank you.

[vba]
Sub ad_ConvertText()
Dim adEntity As AcadObject
Dim adNewMText As AcadMText
Dim adNewText As AcadText
Dim basePnt As Variant
Dim holdStr As String
Dim adselected As Boolean
Dim txtH As Variant
'One of the things you will probably need to address is the Justification
' of the converted text entity. MText uses the AttachmentPoint property
' while Text uses the Alignment property. We demonstrate how to set this
' property, but it will be left to you to implement the conversion for
' the new entity.
On Error Resume Next
adselected = True
Do While adselected = True
Set adEntity = Nothing
ThisDrawing.Utility.GetEntity adEntity, basePnt, "Pick MText Entity>> "
holdStr = adEntity.textString
txtH = adEntity.Height
If adEntity.ObjectName = "AcDbMText" Then
'This call is used to remove MText formatting from the string
If InStr(holdStr, "\P") Then holdStr = replaceStr(holdStr, "\P", " ", False)
Set adNewText = ThisDrawing.ModelSpace.AddText(holdStr, adEntity.insertionPoint, adEntity.Height)
adNewText.Alignment = acAlignmentLeft
adNewText.Update
ElseIf adEntity.ObjectName = "AcDbText" Then
Set adNewMText = ThisDrawing.ModelSpace.AddMText(adEntity.insertionPoint, Len(holdStr), holdStr)
adNewMText.AttachmentPoint = acAttachmentPointTopLeft
adNewMText.Height = txtH
adNewMText.Update
adEntity.Delete
End If
If adEntity Is Nothing Then Exit Sub
Loop
End Sub
[/vba]

[lucas]

I can't get your code to work. You must have a function "replaceStr" because it falls down on it as undefined. There is a clue in the comments of your code though:

MText uses the AttachmentPoint property
' while Text uses the Alignment property. We demonstrate how to set this
' property, but it will be left to you to implement the conversion for
' the new entity.

What did you find when you looked the following up in help?
[VBA]adNewMText.AttachmentPoint = acAttachmentPointTopLeft[/VBA]

[KennyJ]

Sorry that was only part of the code heres the rest I'm still trying to figure this out. Also I realized that this only works in model space and not in layout. If I click text in Layout it converts it and places it in model space. Most or all of our drawings are in layout. The idea is to convert all the text on a drawing to Mtext so I can run a second macro that exports our BOMs to an excel sheet and that that macro only exports Mtext which is why I need to convert the text. What a mess I hope someone can help me or else I have alot of work just converting text to Mtext ahead.
[vba]
Option Explicit

Sub ad_ConvertText()
Dim adEntity As AcadObject
Dim adNewMText As AcadMText
Dim adNewText As AcadText
Dim basePnt As Variant
Dim holdStr As String
Dim adselected As Boolean
'One of the things you will probably need to address is the Justification
' of the converted text entity. MText uses the AttachmentPoint property
' while Text uses the Alignment property. We demonstrate how to set this
' property, but it will be left to you to implement the conversion for
' the new entity.
On Error Resume Next
adselected = True
Do While adselected = True
Set adEntity = Nothing
ThisDrawing.Utility.GetEntity adEntity, basePnt, "Pick Text or MText Entity>> "
holdStr = adEntity.textString
If adEntity.ObjectName = "AcDbMText" Then
'This call is used to remove MText formatting from the string
If InStr(holdStr, "\P") Then holdStr = replaceStr(holdStr, "\P", " ", False)
Set adNewText = ThisDrawing.ModelSpace.AddText(holdStr, adEntity.insertionPoint, adEntity.height)
adNewText.Alignment = acAlignmentLeft
adNewText.Update
ElseIf adEntity.ObjectName = "AcDbText" Then
Set adNewMText = ThisDrawing.ModelSpace.AddMText(adEntity.insertionPoint, Len(holdStr), holdStr)
adNewMText.AttachmentPoint = acAttachmentPointTopLeft
adNewMText.Update
End If
If adEntity Is Nothing Then Exit Sub
adEntity.Delete
Loop
End Sub

Public Function replaceStr(ByVal searchStr As String, ByVal oldStr As String, ByVal newStr As String, _
ByVal firstOnly As Boolean) As String
'This is an older function taken from ad_FindReplace
If searchStr = "" Then Exit Function
If oldStr = "" Then Exit Function
replaceStr = ""
Dim i As Integer, oldStrLen As Integer, holdStr As String, StrLoc As Integer
oldStrLen = Len(oldStr)
StrLoc = InStr(searchStr, oldStr)
While StrLoc > 0
holdStr = holdStr & Left(searchStr, StrLoc - 1) & newStr
searchStr = Mid(searchStr, StrLoc + oldStrLen)
StrLoc = InStr(searchStr, oldStr)
If firstOnly Then replaceStr = holdStr & searchStr: Exit Function
Wend
replaceStr = holdStr & searchStr
End Function


[/vba]

EDIT: Adjusted code for line wrap Tommy

[Tommy]

Hi KennyJ,

This is why the text appears in Model Space
[vba]ThisDrawing.ModelSpace.AddText[/vba]

This is some revised code. It adjust the mtext only (I got side-tracked). I am still working on the text justification..... It would help if you posted a drawing for a sample, zip it up first so you can post it.

[vba]Sub ad_ConvertText()
Dim adEntity As AcadObject
Dim adNewMText As AcadMText
Dim adNewText As AcadText
Dim basePnt As Variant
Dim holdStr As String
'
Dim mNwStr() As String
Dim mI As Integer
Dim mPts() As Double
'
Dim adselected As Boolean
Dim txtH As Variant
'One of the things you will probably need to address is the Justification
' of the converted text entity. MText uses the AttachmentPoint property
' while Text uses the Alignment property. We demonstrate how to set this
' property, but it will be left to you to implement the conversion for
' the new entity.
On Error Resume Next
adselected = True
Do While adselected = True
Set adEntity = Nothing
ThisDrawing.Utility.GetEntity adEntity, basePnt, "Pick MText Entity>> "
If Not adEntity Is Nothing Then
holdStr = adEntity.TextString
txtH = adEntity.Height
If adEntity.ObjectName = "AcDbMText" Then
'This call is used to remove MText formatting from the string
'
'this is a new line character -- the results are not correct
'
If InStr(holdStr, "\P") Then
mNwStr = Split(holdStr, "\P")
mPts = adEntity.InsertionPoint
'this only works when the text rotation is 0
'otherwise some serious math is involved
For mI = 0 To UBound(mNwStr, 1)
If adEntity.AttachmentPoint = acAttachmentPointTopLeft Then
mPts(1) = mPts(1) - adEntity.Height
adEntity.InsertionPoint = mPts
Set adNewText = ThisDrawing.ModelSpace.AddText(mNwStr(mI), _
adEntity.InsertionPoint, adEntity.Height)
Else
'MsgBox adEntity.AttachmentPoint
Set adNewText = ThisDrawing.ModelSpace.AddText(mNwStr(mI), _
adEntity.InsertionPoint, adEntity.Height)
End If
adNewText.Alignment = acAlignmentLeft
adNewText.Update
mPts(1) = mPts(1) - ((adEntity.Height + adEntity.LineSpacingDistance) * mI)
adEntity.InsertionPoint = mPts
Next
Else
Set adNewText = ThisDrawing.ModelSpace.AddText(holdStr, adEntity.InsertionPoint, _
adEntity.Height)
adNewText.Alignment = acAlignmentLeft
adNewText.Update
End If
ElseIf adEntity.ObjectName = "AcDbText" Then
Set adNewMText = ThisDrawing.ModelSpace.AddMText(adEntity.InsertionPoint, _
Len(holdStr), holdStr)
adNewMText.AttachmentPoint = acAttachmentPointBottomLeft
adNewMText.Height = txtH
adNewMText.Update
adEntity.Delete
End If
End If
If adEntity Is Nothing Then Exit Sub
Loop
End Sub
[/vba]

[Tommy]

I got this to work for text entities in 2007, the mtext was placed directly over the text entity selected.

[VBA]Sub ad_ConvertText()
Dim adEntity As AcadObject
Dim adNewMText As AcadMText
Dim adNewText As AcadText
Dim basePnt As Variant
Dim holdStr As String
'
Dim mNwStr() As String
Dim mI As Integer
Dim mPts() As Double
Dim SomNum As Double
'
Dim adselected As Boolean
Dim txtH As Variant
'One of the things you will probably need to address is the Justification
' of the converted text entity. MText uses the AttachmentPoint property
' while Text uses the Alignment property. We demonstrate how to set this
' property, but it will be left to you to implement the conversion for
' the new entity.
On Error Resume Next
adselected = True
Do While adselected = True
Set adEntity = Nothing
ThisDrawing.Utility.GetEntity adEntity, basePnt, "Pick MText Entity>> "
If Not adEntity Is Nothing Then
holdStr = adEntity.TextString
txtH = adEntity.Height
mPts = adEntity.InsertionPoint
If adEntity.ObjectName = "AcDbMText" Then
'This call is used to remove MText formatting from the string
'
'this is a new line character -- the results are not correct
'
If InStr(holdStr, "\P") Then
mNwStr = Split(holdStr, "\P")
mPts = adEntity.InsertionPoint
'this only works when the text rotation is 0
'otherwise some serious math is involved
For mI = 0 To UBound(mNwStr, 1)
If adEntity.AttachmentPoint = acAttachmentPointTopLeft Then
mPts(1) = mPts(1) - adEntity.Height
adEntity.InsertionPoint = mPts
Set adNewText = ThisDrawing.ModelSpace.AddText(mNwStr(mI), _
adEntity.InsertionPoint, adEntity.Height)
Else
'MsgBox adEntity.AttachmentPoint
Set adNewText = ThisDrawing.ModelSpace.AddText(mNwStr(mI), _
adEntity.InsertionPoint, adEntity.Height)
End If
adNewText.Alignment = acAlignmentLeft
adNewText.Update
mPts(1) = mPts(1) - ((adEntity.Height + adEntity.LineSpacingDistance) * mI)
adEntity.InsertionPoint = mPts
Next
Else
Set adNewText = ThisDrawing.ModelSpace.AddText(holdStr, adEntity.InsertionPoint, _
adEntity.Height)
adNewText.Alignment = acAlignmentLeft
adNewText.Update
End If
ElseIf adEntity.ObjectName = "AcDbText" Then
Set adNewMText = ThisDrawing.PaperSpace.AddMText(adEntity.InsertionPoint, _
Len(holdStr), holdStr)
adNewMText.AttachmentPoint = acAttachmentPointBottomLeft
adNewMText.Height = txtH
adNewMText.InsertionPoint = mPts
'adNewMText.Layer = "NewMText"
adNewMText.Update
adEntity.Delete
End If
End If
If adEntity Is Nothing Then Exit Sub
Loop
End Sub
[/VBA]

[KennyJ]

I finally got this working the way I need it to thanks again for all the help.

[Tommy]

Would you post the code you used?

[KennyJ]

This macro takes any single line text that you select and converts it to Mtext then moves it up .03 and only works in Paper Space.

[VBA]Option Explicit

Sub ad_ConvertText()
Dim adEntity As AcadObject
Dim adNewMText As AcadMText
Dim adNewText As AcadText
Dim basePnt As Variant
Dim holdStr As String
Dim adselected As Boolean
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double


On Error Resume Next
adselected = True
Do While adselected = True
Set adEntity = Nothing
ThisDrawing.Utility.GetEntity adEntity, basePnt, "Pick Text or MText Entity>> "
holdStr = adEntity.textString

If adEntity.ObjectName = "AcDbText" Then
Set adNewMText = ThisDrawing.PaperSpace.AddMText(adEntity.insertionPoint, Len(holdStr), holdStr)
adNewMText.AttachmentPoint = acAttachmentPointTopLeft

point1(0) = 0: point1(1) = 0: point1(2) = 0:
point2(0) = 0: point2(1) = 0.03: point2(2) = 0:

adNewMText.Move point1, point2
adNewMText.Update
adEntity.Delete
End If
If adEntity Is Nothing Then Exit Sub
Loop
End Sub
[/VBA]

[Strine]

[QUOTE=KennyJ;148301]This macro takes any single line text that you select and converts it to Mtext then moves it up .03 and only works in Paper Space.

Great work Kenny but...

How exactly do I apply the slab of text to autocad so that indeed I can change single line text into multi line text. I understand readers of this thread are no doubt well versed in creating macros etc but sadly I am not. Any help would be much appreciated. Thanks.