【答坛友】宏，更改绘图标准

问题来源：https://www.icax.org/thread-955249-1-1.html

条件：1、SOLIDWORKS零件、工程图或装配体环境
           2、首先在SW选项中，另存为绘图标准文件，将绘图标准文件(*.sldstd类型)放至本宏同一目录！
2011与2013版测试通过，如有提示错误，请调试宏，在工具/引用中，重新添加引用。

密码如下：

游客，如果您要查看本帖隐藏内容请回复

代码如下：

1. ' ******************************************************************************
   
2. '宏名：更改绘图标准
   
3. '作者： qiminger  QQ：261744899
   
4. '条件：1、SolidWorks零件、工程图或装配体环境
   
5. '      2、首先在SW选项中，另存为绘图标准文件，将绘图标准文件(*.sldstd类型)放至本宏同一目录！
   
6. ' ******************************************************************************
   
7. Dim swApp As Object
   
8. Dim Part As Object
   
9.     Dim 本宏目录 As String
   
10.     Dim 标准文件 As String
    
11.     Dim 标准文件全名 As String
    
12. Sub main()
    
13. Set swApp = Application.SldWorks
    
14. Set Part = swApp.ActiveDoc
    
15.     本宏目录 = swApp.GetCurrentMacroPathName '获得本宏文件路径+文件名
    
16.     本宏目录 = Left(本宏目录, InStrRev(本宏目录, ""))  '提出路径
    
17.     标准文件 = Dir(本宏目录 & "*.sldstd") '搜寻标准文件
    
18.     标准文件全名 = 本宏目录 & 标准文件
    
19.     If 标准文件 = "" Then
    
20.         MsgBox "没有绘图标准文件，请把绘图标准文件(*.sldstd类型)放至本宏同一目录！"
    
21.         Exit Sub
    
22.     End If
    
23.         If 标准文件 <> "" Then Part.Extension.LoadDraftingStandard 标准文件全名
    
24. Part.ForceRebuild3 False
    
25. Part.ViewZoomtofit2
    
26. Part.Save2 Silent
    
27. End Sub

复制代码

謝謝前輩分享~~

1. Sub main()
   
2. Set swApp = Application.SldWorks
   
3. Set Part = swApp.ActiveDoc
   
4.     macropath = swApp.GetCurrentMacroPathName
   
5.     macropath = Left(macropath, InStrRev(macropath, ""))
   
6.     stdfile = macropath & Dir(macropath & "*.sldstd")
   
7.     MsgBox stdfile
   
8.     If stdfile = "" Then
   
9.         MsgBox "No sw-standard files exist!"
   
10.     Else
    
11.         Part.Extension.LoadDraftingStandard stdfile
    
12.     End If
    
13. Part.ForceRebuild3 False
    
14. Part.Save2 Silent
    
15. End Sub
    

复制代码

{:soso_e183:}  发帖回答的风格，哈哈。
英雄所见略同（自我感觉良好一下）

支持~规范和和谐的网络讨论习惯和氛围~

顺带问一下，这样的形式，把代码贴在论坛上的做事，是如何实现的？请指教。

vincent3166 发表于 2015-1-23 11:43
顺带问一下，这样的形式，把代码贴在论坛上的做事，是如何实现的？请指教。

gt.adan 发表于 2015-1-23 11:56

thanks ~`
so good ~

谢谢

谢谢！

谢谢大声的解答。。。我这还有一件事请您帮忙--前段时间看到一位版主分享的关于更换sw图纸模板格式的宏代码。。我也是受益匪浅，在此请问大神能否把两个宏程序结合在一起，这样用起来更加方便，那位版主的宏程序如下：Sub Main()
Set swApp = Application.SldWorks
Set Drawing = swApp.ActiveDoc
If Drawing.GetType <> 3 Then Exit Sub
RetoreSheetName = Drawing.GetCurrentSheet.GetName
SheetName = Drawing.GetSheetNames
SheetCount = Drawing.GetSheetCount
For i = 0 To SheetCount - 1
    Drawing.ActivateSheet SheetName(i)
    swTemplate = Drawing.GetCurrentSheet.GetTemplateName
    swTemplatePath = Split(swTemplate, "\")
    swTemplate = swTemplatePath(UBound(swTemplatePath))
    vSheetProps = Drawing.GetCurrentSheet.GetProperties()
    Drawing.SetupSheet4 Drawing.GetCurrentSheet.GetName, 0, 0, vSheetProps(2), vSheetProps(3), vSheetProps(4), "", 1, 1, ""
    Drawing.SetupSheet4 Drawing.GetCurrentSheet.GetName, 12, 12, vSheetProps(2), vSheetProps(3), vSheetProps(4), swTemplate, 0, 0, ""
    vSheetProps = Drawing.GetCurrentSheet.GetProperties()
Next
Drawing.ActivateSheet RetoreSheetName
End Sub

天真无邪 发表于 2015-1-29 10:39
谢谢大声的解答。。。我这还有一件事请您帮忙--前段时间看到一位版主分享的关于更换sw图纸模板格式的宏代码 ...

我对宏了解的也不算好，替换格式代码主要在for循环中，把替换标准代码插入里面即可。
如下：

1. Sub main()
   
2. Set swApp = Application.SldWorks
   
3. Set Drawing = swApp.ActiveDoc
   
4. If Drawing.GetType <> 3 Then Exit Sub
   
5. RetoreSheetName = Drawing.GetCurrentSheet.GetName
   
6. SheetName = Drawing.GetSheetNames
   
7. SheetCount = Drawing.GetSheetCount
   
8. 
   
9.     '更改绘图标准+++++++++++++++
   
10.     Dim 本宏目录 As String
    
11.     Dim 标准文件 As String
    
12.     Dim 标准文件全名 As String
    
13.     本宏目录 = swApp.GetCurrentMacroPathName '获得本宏文件路径+文件名
    
14.     本宏目录 = Left(本宏目录, InStrRev(本宏目录, ""))  '提出路径
    
15.     标准文件 = Dir(本宏目录 & "*.sldstd") '搜寻标准文件
    
16.     标准文件全名 = 本宏目录 & 标准文件
    
17.     If 标准文件 = "" Then
    
18.         MsgBox "没有绘图标准文件，请把绘图标准文件(*.sldstd类型)放至本宏同一目录！"
    
19.         Exit Sub
    
20.     End If
    
21.     '+++++++++++++++
    
22.    
    
23. For i = 0 To SheetCount - 1
    
24.     Drawing.ActivateSheet SheetName(i)
    
25.     swTemplate = Drawing.GetCurrentSheet.GetTemplateName
    
26.     swTemplatePath = Split(swTemplate, "")
    
27.     swTemplate = swTemplatePath(UBound(swTemplatePath))
    
28.     vSheetProps = Drawing.GetCurrentSheet.GetProperties()
    
29.     Drawing.SetupSheet4 Drawing.GetCurrentSheet.GetName, 0, 0, vSheetProps(2), vSheetProps(3), vSheetProps(4), "", 1, 1, ""
    
30.     Drawing.SetupSheet4 Drawing.GetCurrentSheet.GetName, 12, 12, vSheetProps(2), vSheetProps(3), vSheetProps(4), swTemplate, 0, 0, ""
    
31.     vSheetProps = Drawing.GetCurrentSheet.GetProperties()
    
32.    
    
33.     '更改绘图标准+++++++++++++++
    
34.         If 标准文件 <> "" Then Drawing.Extension.LoadDraftingStandard 标准文件全名
    
35.         Drawing.Save2 Silent
    
36.     '+++++++++++++++
    
37.    
    
38. Next
    
39. Drawing.ActivateSheet RetoreSheetName
    
40. End Sub

复制代码