- 积分
- 15190
- 明经币
- 个
- 注册时间
- 2003-9-13
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2003-9-22 22:33:00
|
显示全部楼层
可以先在CAD 里面设置啊
不过还是在VBA里先设置较专业一点 如下例
'设置字体为宋体
Dim typeface As String
Dim textbold As Boolean
Dim textitalic As Boolean
Dim textcharset As Long
Dim textpfamily As Long
ThisDrawing.ActiveTextStyle.GetFont typeface, _
textbold, textitalic, textcharset, textpfamily
typeface = "宋体"
ThisDrawing.ActiveTextStyle.SetFont typeface, _
textbold, textitalic, textcharset, textpfamily
ThisDrawing.Regen acActiveViewport
'添加文字
Dim textobject(0 To 6) As AcadText
Dim textstring(0 To 6) As String
Dim insertionpoint1(0 To 2) As Double
Dim insertionpoint2(0 To 2) As Double
Dim insertionpoint3(0 To 2) As Double
Dim insertionpoint4(0 To 2) As Double
Dim insertionpoint5(0 To 2) As Double
Dim insertionpoint6(0 To 2) As Double
Dim insertionpoint7(0 To 2) As Double
Dim textheight As Double
textstring(0) = "制图"
insertionpoint1(0) = pt8(0) + 3
insertionpoint1(1) = pt8(1) + 1
insertionpoint1(2) = pt8(2)
Set textobject(0) = ThisDrawing.ModelSpace. _
AddText(textstring(0), insertionpoint1, 5)
textstring(1) = "审核"
insertionpoint2(0) = pt4(0) + 3
insertionpoint2(1) = pt4(1) + 1
insertionpoint2(2) = pt4(2)
Set textobject(0) = ThisDrawing.ModelSpace. _
AddText(textstring(1), insertionpoint2, 5)
textstring(2) = "图号"
insertionpoint3(0) = pt18(0) + 6
insertionpoint3(1) = pt18(1) + 1
insertionpoint3(2) = pt18(2)
Set textobject(0) = ThisDrawing.ModelSpace. _
AddText(textstring(2), insertionpoint3, 5)
textstring(3) = "材料"
insertionpoint4(0) = pt18(0) + 6
insertionpoint4(1) = pt18(1) - 6.5
insertionpoint4(2) = pt18(2)
Set textobject(0) = ThisDrawing.ModelSpace. _
AddText(textstring(3), insertionpoint4, 5)
textstring(4) = "件数"
insertionpoint5(0) = pt16(0) - 19
insertionpoint5(1) = pt16(1) + 1
insertionpoint5(2) = pt16(2)
Set textobject(0) = ThisDrawing.ModelSpace. _
AddText(textstring(4), insertionpoint5, 5)
textstring(5) = "华南热带农业大学00级农机A班"
insertionpoint6(0) = pt13(0) + 6
insertionpoint6(1) = pt13(1) + 2
insertionpoint6(2) = pt13(2)
textheight = 5
Set textobject(0) = ThisDrawing.ModelSpace. _
AddText(textstring(5), insertionpoint6, 3)
'限制制图人姓名的输入不超出4个字符
Dim textbox1text As String * 4
textbox1text = TextBox1.Text
textstring(6) = textbox1text
insertionpoint7(0) = pt20(0) + 2
insertionpoint7(1) = pt20(1) - 6.5
insertionpoint7(2) = pt20(2)
Set textobject(6) = ThisDrawing.ModelSpace. _
AddText(textstring(6), insertionpoint7, 5) |
|