- 积分
- 6409
- 明经币
- 个
- 注册时间
- 2017-8-16
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
楼主 |
发表于 2018-8-1 16:50:33
|
显示全部楼层
已解决,发部分源码在这里,希望给不会的一点参考
- Public Sub LoadAcadAPP()
- Dim n&, newText As Object
- Dim ys As Object
- Dim typeFace$,lujin$,SavetypeFace$
- Dim Bold As Boolean
- Dim Italic As Boolean
- Dim charSet As Long
- Dim PitchandFamily As Long
- On Error Resume Next
- Set acadApp = GetObject(, "AutoCAD.Application")
- If Err Then
- Err.Clear
- Set acadApp = CreateObject("AutoCAD.Application")
- If Err Then End
- Else
- Set acadDoc = acadApp.Documents.Add
- End If
- acadApp.Visible = True
- acadApp.WindowState = acMax
- n = acadApp.Documents.Count
- Set acadDoc = acadApp.Documents(n - 1)
- '以下为第一种方法
- lujin = acadDoc.ActiveTextStyle.fontFile
- lujin = SplitLast(lujin, "")
- lujin = Replace(lujin, "", "/")
- If acadDoc.ActiveTextStyle.BigFontFile = "" Then
- acadDoc.ActiveTextStyle.BigFontFile = lujin & "gbcbig.shx"
- End If
- '以下为第二种方法
- acadDoc.ActiveTextStyle.GetFont typeFace, Bold, Italic, charSet, PitchandFamily
- If typeFace <> "宋体" Then typeFace = "宋体"
- acadDoc.ActiveTextStyle.SetFont typeFace, Bold, Italic, charSet, PitchandFamily
- acadDoc.Regen acActiveViewport
- End Sub
- Public Function SplitLast(ByVal S, ByVal cr)
- '去掉符号后面的字符串
- Dim i&, j&
- i = Len(S)
- For j = i To 1 Step -1
- If cr = Mid(S, j, 1) Then
- SplitLast = Mid(S, 1, j)
- Exit Function
- End If
- Next j
- End Function
|
评分
-
查看全部评分
|