CAD VBA关于根据文字内容 修改文字属性的问题
我初学VBA 看看书试着编写了下面这段代码主要功能就是打开CAD文件后 选择所有文字然后根据文字的内容修改其属性 &...
我初学VBA 看看书 试着编写了下面这段代码 主要功能就是打开CAD文件后 选择所有文字 然后根据文字的内容 修改其属性
ThisDrawing.Application.Documents.Open dwgfile
Dim styel1 As AcadTextStyle
Dim fontset As Object
On Error GoTo errcontrol
Dim sname As String
Set fontset = ThisDrawing.SelectionSets.Add("example")
Dim ftype(0) As Integer
Dim fdata(0) As Variant
ftype(0) = 0
fdata(0) = "text"
fontset.Select acSelectionSetAll, , , ftype, fdata
Dim sfont As object
For Each sfont In fontset
‘下面这句 如果替换成sfont.height = 10 整个程序就能正常运行
If sfont.TextString = "你好中国" Then
sname = sfont.StyleName
Set style1 = ThisDrawing.TextStyles.Item(sname)
ThisDrawing.ActiveTextStyle = style1
sfont.StyleName = "stardand"
ThisDrawing.ActiveTextStyle.fontFile = "E:\Program Files\AutoCAD Map 3D 2010\Fonts\FZYTK.TTF"
Else
sname = sfont.StyleName
Set style1 = ThisDrawing.TextStyles.Item(sname)
ThisDrawing.ActiveTextStyle = style1
sfont.StyleName = "legend"
ThisDrawing.ActiveTextStyle.fontFile = "E:\Program Files\AutoCAD Map 3D 2010\Fonts\SIMLI.TTF"
End If
sfont.Update
Next sfont
ThisDrawing.SelectionSets("example").Delete
ThisDrawing.Regen acAllViewports
Unload Me
errcontrol:
ThisDrawing.Regen acAllViewports
ThisDrawing.Save
由于初学 代码写的肯定存在不少问题 请大侠们不吝赐教 发现问题了就教教我 不光关键代码 其他地方也算 如果
如果有哪位大侠把修改精简后的代码 发上来 我愿意追加悬赏分! 展开
ThisDrawing.Application.Documents.Open dwgfile
Dim styel1 As AcadTextStyle
Dim fontset As Object
On Error GoTo errcontrol
Dim sname As String
Set fontset = ThisDrawing.SelectionSets.Add("example")
Dim ftype(0) As Integer
Dim fdata(0) As Variant
ftype(0) = 0
fdata(0) = "text"
fontset.Select acSelectionSetAll, , , ftype, fdata
Dim sfont As object
For Each sfont In fontset
‘下面这句 如果替换成sfont.height = 10 整个程序就能正常运行
If sfont.TextString = "你好中国" Then
sname = sfont.StyleName
Set style1 = ThisDrawing.TextStyles.Item(sname)
ThisDrawing.ActiveTextStyle = style1
sfont.StyleName = "stardand"
ThisDrawing.ActiveTextStyle.fontFile = "E:\Program Files\AutoCAD Map 3D 2010\Fonts\FZYTK.TTF"
Else
sname = sfont.StyleName
Set style1 = ThisDrawing.TextStyles.Item(sname)
ThisDrawing.ActiveTextStyle = style1
sfont.StyleName = "legend"
ThisDrawing.ActiveTextStyle.fontFile = "E:\Program Files\AutoCAD Map 3D 2010\Fonts\SIMLI.TTF"
End If
sfont.Update
Next sfont
ThisDrawing.SelectionSets("example").Delete
ThisDrawing.Regen acAllViewports
Unload Me
errcontrol:
ThisDrawing.Regen acAllViewports
ThisDrawing.Save
由于初学 代码写的肯定存在不少问题 请大侠们不吝赐教 发现问题了就教教我 不光关键代码 其他地方也算 如果
如果有哪位大侠把修改精简后的代码 发上来 我愿意追加悬赏分! 展开
1个回答
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询