AutoCAD VBA简单文字操作,包括几个简单的文字操作函数,代码如下。
Public Function AddText(ByVal text As String, ByVal ptinsert As Variant, ByVal height As Double) As AcadText
Set AddText = ThisDrawing.ModelSpace.AddText(text, ptinsert, height)
End Function
Public Function AddTextHA(ByVal text As String, ByVal ptinsert As Variant, ByVal height As Double, ByVal angle As Double) As AcadText
Dim objText As AcadText
Set objText = ThisDrawing.ModelSpace.AddText(text, ptinsert, height)
objText.Rotate ptinsert, angle
objText.udate
Set AddTextHA = objText
End Function
Public Function AddMtext(ByVal ptinsert As Variant, ByVal width As Double, ByVal text As String) As AcadMText
Set AddMtext = ThisDrawing.ModelSpace.AddMtext(ptinsert, width, text)
End Function
Public Function AddMtextHA(ByVal ptinsert As Variant, ByVal width As Double, ByVal text As String, ByVal height As Double, ByVal angle As Double) As AcadMText
Dim objMtext As AcadMText
Set objMtext = ThisDrawing.ModelSpace.AddMtext(ptinsert, width, text)
objMtext.height = height
objMtext.Rotate = angle
Set AddMtextHA = objMtext
End Function
Public Sub TestText()
Dim ptinsert(2) As Double
ptinsert(0) = 100: ptinsert(1) = 100: ptinsert(2) = 0
AddText "AutoCAD 2004", ptinsert, 5
ptinsert(0) = 100: ptinsert(1) = 110: ptinsert(2) = 0
AddMtext ptinsert, 30, "VBA 程序设计"
ptinsert(0) = 100: ptinsert(1) = 120: ptinsert(2) = 0
AddTextHA "清华大学出版社", ptinsert, 5, 0.4
ptinsert(0) = 100: ptinsert(1) = 140: ptinsert(2) = 0
AddMtextHA ptinsert, 50, "明经通道欢迎你", 5, 0.4
ZoomExtents
End Sub
代码完。
”明经通道欢迎你“没有显示出来,提示438错误“对象不支持该属性或方法”。