代码改变世界

VB编程操作AutoCAD单行文字

2011-06-17 21:57  精诚所至 金石为开  阅读(1190)  评论(0编辑  收藏  举报

用文档对象的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