AutoCAD VBA 获取字体样式列表

cad中的可用字体样式

 

 

获取windows标准字体

Dim winFontsdir As String
    
    winFontsdir = VBA.Environ("windir") & "\Fonts\"
    If winFontsdir <> vbNullString Then
        Dim shxfl As String
        shxfl = VBA.dir(winFontsdir)
        While shxfl <> vbNullString
            Debug.Print winFontsdir & shxfl
            shxfl = dir()
        Wend
    End If

获取cad字体样式名称

 

Dim temp As Variant, i As Long, fontDir As String
    temp = VBA.Split(Application.Preferences.Files.SupportPath, ";")
    For i = LBound(temp) To UBound(temp)
        If temp(i) Like "*\fonts" Then
            fontDir = temp(i) & "\"
            Exit For
        End If
    Next
    If fontDir <> vbNullString Then
        Dim shxfl As String
        shxfl = VBA.dir(fontDir)
        While shxfl <> vbNullString
            Debug.Print fontDir & shxfl
            shxfl = dir()
        Wend
    End If