用文档对象的AddText方法可以创建单行文本对象,结合文本字体设置,可以显示丰富多彩的文字,创建单行文本的语法如下所示。
RetVal=object.AddText(TextString,InsertionPoint,Height)
RetVal新创建的单行文本对象,Object模型空间、图纸空间块对象,TextString字符串型,要显示的文本内容,InsertionPoint双精度型,文本插入点坐标,Height文字高度。下面的代码使用不同的字体,创建单行文字对象。
Private Sub Command1_Click()
Dim styobj1 As AcadTextStyle
Dim typeface As String
Dim bold As Boolean
Dim italic As Boolean
Dim charset As Long
Dim pitchandfamily As Long
Set styobj1 = acadapp.ActiveDocument.TextStyles.Add("自定义文字样式")
typeface = "宋体"
italic = True
bold = True
charset = 1
pitchandfamily = 1 Or 16
styobj1.SetFont typeface, bold, italic, charset, pitchandfamily
Dim styobj2 As AcadTextStyle
Set styobj2 = acadapp.ActiveDocument.TextStyles.Add("自定义")
styobj2.fontFile = "C:\windows\fonts\vani.ttf"
Dim textobj As AcadText
Dim textstring As String
Dim insertionpoint(0 To 2) As Double
Dim height As Double
textstring = "acad二次开发"
height = 0.3
insertionpoint(0) = 5#: insertionpoint(1) = 2#: insertionpoint(2) = 0
acadapp.ActiveDocument.ActiveTextStyle = styobj1
Set textobj = acadapp.ActiveDocument.ModelSpace.AddText(textstring, insertionpoint, height)
textobj.Update
insertionpoint(0) = 5: insertionpoint(1) = 1: insertionpoint(2) = 0
acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set textobj = acadapp.ActiveDocument.ModelSpace.AddText(textstring, insertionpoint, height)
textobj.Update
styobj2.fontFile = "C:\windows\fonts\vani.ttf"
insertionpoint(0) = 5: insertionpoint(1) = 0: insertionpoint(2) = 0
acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set textobj = acadapp.ActiveDocument.ModelSpace.AddText(textstring, insertionpoint, height)
textobj.Update
ZoomExtents
End Sub