본문 바로가기

CAD(Lisp, VBA)

CAD - VBA를 이용한 TextStyle 설정

Sub textstylelist()
    Dim textStyle As AcadTextStyle
    Dim fontfilename As String
    Dim bigfontfilename As String
    Dim Stylename As String
    Dim newFontFile, newbigFontFile As String
    Dim StyleCount As Integer
    Dim i As Integer
    
    Set AcadApp = GetObject(, "AutoCad.Application")
    AppActivate AcadApp.Caption   '오토캐드 창 활성화시키기 (윗줄까지 2줄 필요)
    'Set textStyle = ThisDrawing.ActiveTextStyle   '현재설정된 TextStyle 로

    
    '정의된 TextStyle 갯수 얻기
    StyleCount = ThisDrawing.TextStyles.count

    '정의된 TextStyle 갯수만큼 반복
    For i = 1 To StyleCount
        Set textStyle = ThisDrawing.TextStyles.Item(i - 1)  '실제 0부터 시작
        Stylename = textStyle.Name                  '스타일 이름
        fontfilename = textStyle.fontfile           '스타일 사용글꼴
        bigfontfilename = textStyle.bigfontfile     '스타일 글꼴스타일
       
        If bigfontfilename = "" Then MsgBox i & "번째" & Chr(13) & "스타일 : " & Stylename & Chr(13) & "글꼴이름 : " & fontfilename & Chr(13) & "글꼴스타일 : 아무것도 없음" & Chr(13) & Right(fontfilename, 15)
   
        '스타일 바꾸기
        Select Case Right(fontfilename, 15)
            Case "HYWULM.TTF", "H2WULM.TTF"
                newFontFile = "HY울릉도M"
           
            'Case "HYWULM.TTF", "H2WULM.TTF", "HywulM.TTF"
                'newFontFile = "C:/Windows/Fonts/HY울릉도M.TTF"
                'newbigFontFile = ""
           
                ' bigfont 사용하기
                'newFontFile = "C:/Program Files/AutoCAD 2009/Fonts/romans.shx"
                'newbigFontFile = "C:/Program Files/AutoCAD 2009/Fonts/ghs.shx"
            '    textStyle.fontfile = newFontFile
            '    textStyle.bigfontfile = newbigFontFile
               
            Case "HYWULL.TTF", "H2WULL.TTF"
                newFontFile = "D:/Windows/Fonts/필기체.TTF"
           
                ' Change the value for FontFile
                'newFontFile = "C:/Program Files/AutoCAD 2009/Fonts/romans.shx"
                'newbigFontFile = "C:/Program Files/AutoCAD 2009/Fonts/ghs.shx"
                textStyle.fontfile = newFontFile
            '    textStyle.bigfontfile = newbigFontFile
           
            Case "HY태백B.TTF"
                'HY울릉도L 폰트설정
                newFontFile = "C:/Windows/Fonts/HY울릉도M.TTF"
                textStyle.fontfile = newFontFile
                textStyle.bigfontfile = newbigFontFile
        End Select
    Next i
    MsgBox StyleCount & "개의 TextStyle이 사용되었습니다.마침"
End Sub