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