VBA添加文字出现乱码的问题?急!
程序如下:Dim MyTxt As AcadText
Dim Pn(0 To 2) As Double
Pn(0) = 100: Pn(1) = 100
Set MyTxt = ThisDrawing.ModelSpace.AddText("你好", Pn, 20)
添加后在CAD中显示为“??”
我看了一下属性:内容为”你好“;样式为”Standard“
然后我用CAD命令添加”你好“,没有出现乱码
其对应属性为:内容为”{f宋体|b0|i0|c134|p54|;你好“};样式为”Standard“
最讨厌的是我用”Style"命令将字体改为“宋体”后不会出现“??”能正常显示
但我修改一下线型就出现致命错误。
不知那位高手有什么建议,十分感谢!! 你先用程序把字体样式改为中文的。 ' 下面这段代码是我用vb写的,我也曾遇到此类问题
’ 先设置文本输出样式,看cad的帮助
Dim TextObject As AcadText
Dim xTextStyle As AcadTextStyle
Set xTextStyle = NewDoc.ActiveTextStyle ‘ NewDoc is ActiveDocument
xTextStyle.SetFont "宋体", 0, 0, 0, 0 上面的方法可以改变字体不会出现“??”这样的东西,但我加载了一些自己定义
的线型后,就不能修改线的线型,否则出现致命错误。
我分析是不是与线型的用到的字体什么的有关系。我认为是线型字体与当前图形字体的冲突从而产生致命错误。但不知道如何去解决。不知道我的分析是否真确。
希望高手指教 可以先在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)
页:
[1]