change font for Mtext

[nguyendan81985]

hi all

 

i have exsample Mtext code as below, but i dont know how to change the Font for this MText. if you know please help me. thanks

 

Sub AddMtext()

 

Dim MTextObj As AcadMText

Dim point(0 To 2) As Double

Dim width As Double

Dim text As String

point(0) = 0#: point(1) = 10#: point(2) = 0#

width = 10

text = "ABC"

 

Set MTextObj = ThisDrawing.ModelSpace.AddMText(point, width, text)

ZoomAll

 

End Sub

[fixo]

You may want to use mtext formatting

see quick example:

Option Explicit

Sub Example_AddMtext()

' This example creates an MText object in model space

' and align it to bottom center

 

Dim MTextObj As AcadMText

Dim pickPt

Dim corner(0 To 2) As Double

Dim width As Double

Dim txtheight As Double

Dim font As String

font = "Comic Sans MS"

Dim text As String

pickPt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Pick text position: ")

corner(0) = pickPt(0): corner(1) = pickPt(1): corner(2) = 0#

txtheight = ThisDrawing.GetVariable("textsize")

 

text = "This is a mtext string with\Pusing " & """" & font & """" & " font"

Dim wid As Variant

wid = Split(text, "\P", -1, vbTextCompare)

text = "\A;\f" & font & "|b1|i1|c0|p0;" & text

 

width = Len(CStr(wid(0))) * txtheight * 0.875

'' Creates the mtext Object

Set MTextObj = ThisDrawing.ModelSpace.AddMText(corner, width, text)

'' align to bottom center

MTextObj.AttachmentPoint = acAttachmentPointBottomCenter

'' reset position

MTextObj.InsertionPoint = corner

Dim minExt As Variant

Dim maxExt As Variant

 

' Return the bounding box for the line and return the minimum

' and maximum extents of the box in the minExt and maxExt variables.

MTextObj.GetBoundingBox minExt, maxExt

width = maxExt(0) - minExt(0)

MTextObj.width = width

 

 

End Sub