求教根据内容修改字体的问题

xfm334 · 发表于 2011-7-3 12:34:00

我初学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\ 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
由于初学  代码写的肯定存在不少问题请大侠们不吝赐教发现问题了就教教我  不光关键代码其他地方也算  如果可以写的更精简些  那就更好了呵呵！
非常感谢！