rielzhou 发表于 2006-12-21 20:34:00

在vba中如何获取所有字体!

怎样才能在窗体的复合框中显示系统和CAD中所有的字体啊??
谢谢各位!!!!

rielzhou 发表于 2006-12-25 13:10:00

怎么没有人回答我呢??
真是伤心啊
难道就没有一位高手愿意帮忙吗?

mccad 发表于 2006-12-25 13:40:00

需要得到字体所在的目录，读取所有文件名并进行判断。

rielzhou 发表于 2006-12-26 12:48:00

具体怎么操作啊?
如何读取字体文体啊?

rielzhou 发表于 2006-12-26 12:50:00

能不能给一段示例代码啊?

青青20 发表于 2006-12-26 14:11:00

在autocad vba 二次开发教程第五章有一个类似的例子下面是部分)
Option Explicit
' 获得SHX字体
Public Function GetShxFont(ByVal bBigFont As Boolean) As Variant
    Dim strFontFileName() As String   ' 所有字体名称的数组
    Dim strFontPath() As String   ' AutoCAD的字体文件路径
   
    ' 获得所有的支持文件路径
    strFontPath = Split(ThisDrawing.Application.Preferences.Files, ";")
   
    ' 遍历所有的支持文件路径
    Dim i As Integer
    Dim bFirst As Boolean       ' 是否是第一次查找该文件夹
    Dim strFont As String       ' 字体文件名称
    Dim strTemp As String       ' 读取到的字体文件的一行
    Dim intCount As Integer   ' 字体数组的维数
    Dim strFontFile As String   ' 字体文件的位置
    intCount = -1
    For i = 0 To UBound(strFontPath)
      bFirst = True
      ' 确保最后一个字符是"\"
      strFontPath(i) = IIf(Right(strFontPath(i), 1) = "\", strFontPath(i), strFontPath(i) & "\")
      
      Do
            If bFirst Then
                strFont = Dir(strFontPath(i) & "*.shx")
                bFirst = False
            Else
                strFont = Dir
            End If
            
            If Len(strFont)0 Then
                ' 打开字体文件
                strFontFile = strFontPath(i) & strFont
                Open strFontFile For Input As #1
                Line Input #1, strTemp
                Close #1
               
                ' 判断字体的类型
                If bBigFont Then
                  If Mid(strTemp, 12, 7) = "bigfont" Then
                        intCount = intCount + 1
                        ReDim Preserve strFontFileName(intCount)
                        strFontFileName(intCount) = strFont
                  End If
                Else
                  If Mid(strTemp, 12, 7) = "unifont" Or Mid(strTemp, 12, 6) = "shapes" Then
                        intCount = intCount + 1
                        ReDim Preserve strFontFileName(intCount)
                        strFontFileName(intCount) = strFont
                  End If
                End If
            Else
                Exit Do
            End If
      Loop
    Next i
   
    GetShxFont = strFontFileName
End Function

rielzhou 发表于 2006-12-27 22:49:00

多谢楼上的大侠!!!
不过有个新的问题
我获取了字体文件之后只能得到字体文件的名称,而无法得到字体的名称
请大侠再指点迷津
感激不尽
页: [1]
查看完整版本: 在vba中如何获取所有字体!