iCAx开思网

标题: 【答坛友】宏，更改绘图标准 [打印本页]
作者: qiminger    时间: 2015-1-23 08:17
标题: 【答坛友】宏，更改绘图标准
问题来源：https://www.icax.org/thread-955249-1-1.html

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

代码如下：
  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
复制代码





作者: gt.adan    时间: 2015-1-23 10:46
本帖最后由 gt.adan 于 2015-1-23 11:53 编辑

謝謝前輩分享~~
  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
复制代码


作者: vincent3166    时间: 2015-1-23 11:23
本帖最后由 vincent3166 于 2015-1-23 11:30 编辑

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

支持~规范和和谐的网络讨论习惯和氛围~
作者: vincent3166    时间: 2015-1-23 11:43
顺带问一下，这样的形式，把代码贴在论坛上的做事，是如何实现的？请指教。

[attach]1214611[/attach]
作者: gt.adan    时间: 2015-1-23 11:56
vincent3166 发表于 2015-1-23 11:43
顺带问一下，这样的形式，把代码贴在论坛上的做事，是如何实现的？请指教。

[attach]1214612[/attach]
作者: vincent3166    时间: 2015-1-23 12:22
gt.adan 发表于 2015-1-23 11:56

thanks ~`
so good ~
作者: wyj123    时间: 2015-1-24 08:20
谢谢
作者: 地雷工程师    时间: 2015-1-26 13:02
谢谢！
作者: 天真无邪    时间: 2015-1-29 10:39
谢谢大声的解答。。。我这还有一件事请您帮忙--前段时间看到一位版主分享的关于更换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
作者: qiminger    时间: 2015-1-29 13:42
天真无邪 发表于 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

  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
复制代码


作者: 天真无邪    时间: 2015-1-29 21:02
file:///C:\Users\Administrator\AppData\Roaming\Tencent\Users\1019994367\QQ\WinTemp\RichOle\}RB(]USWB$~`9A6HPM0NZ$T.png[attach]1214889[/attach] 大神 我运行程序的时候出现这个画面  能帮我解答一下吗

作者: 天真无邪    时间: 2015-1-29 22:18
大神  你好  上面的问题自己已经解决   但是我又遇到一个问题   如图  成功更换会图标准后   单位却没有跟着改变[img=0,1]file:///C:\Users\Administrator\AppData\Roaming\Tencent\Users\1019994367\QQ\WinTemp\RichOle\V]GZ3ABD8MGYOZ`[U$W2ADG.png[/img][attach]1214890[/attach]
作者: 远行云在下    时间: 2015-3-27 17:59
试试也好!
作者: 326347    时间: 2015-3-29 10:19
好东西，谢谢分享
作者: ac250626    时间: 2015-3-30 12:59
谢谢楼主我也学习一下宏。
作者: cx0527    时间: 2015-4-15 20:10
看一下怎么样
作者: kcrscad    时间: 2015-4-22 11:47
支持~规范和和谐的网络讨论习惯和氛围~
作者: 龙之梦_4506    时间: 2015-4-22 12:45
看看怎么样
作者: 杀苏    时间: 2015-4-22 21:19
看看 ，谢谢分享
作者: yanwoxiaoqiang    时间: 2015-4-24 08:59
学习拉 很棒
作者: ep2708605440    时间: 2015-4-25 20:12
我是新手 一直想好好学习
作者: 忘川啊    时间: 2015-4-30 13:19
谢谢分享
作者: econn00    时间: 2015-7-5 20:04
好好好好好好，好东西

作者: scattie    时间: 2015-7-6 09:17
哇!!!太讚了,感謝無私地分享~~~
作者: cendepeng    时间: 2015-7-6 22:31
绘图标准和工程图模板一样？
作者: 188chp    时间: 2015-8-4 08:07
谢谢分享
作者: allentj    时间: 2015-10-4 14:59
这个比较常用，学习学习
作者: chenwuguan    时间: 2015-11-16 22:03
学习了，不过这些宏究竟怎么开发的？？
作者: ygsl1991    时间: 2015-12-2 14:29
谢谢，学习下
作者: zhangcj48    时间: 2015-12-25 10:30
学习一下谢楼主。
作者: chhz916    时间: 2015-12-25 16:58
一键修改么?我每次出图要修改尺寸单位,好麻烦

作者: 黑暗贤者    时间: 2015-12-25 17:25
不错的资料，学习下。。
作者: michaelxxl    时间: 2016-2-6 19:52
啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊
作者: michaelxxl    时间: 2016-2-6 19:52
感谢楼主
作者: hyyd29    时间: 2016-2-8 09:27
谢谢，学习学习！
作者: geshuai1993    时间: 2016-2-29 01:23
学习一下了
作者: jin198250    时间: 2016-3-7 15:16
感谢分享
作者: 口风琴    时间: 2016-4-6 00:29
谢谢朋友分享，
作者: zhczhc1991    时间: 2016-4-26 16:04
看看，貌似有点需要
作者: eastking1111    时间: 2016-4-26 16:51
感谢你的分享
作者: oscar171    时间: 2016-6-17 09:43
希望好用
作者: litao036    时间: 2016-6-18 16:50
看看怎么样啊
作者: cx0527    时间: 2016-6-18 16:57
支持~规范和和谐的网络讨论习惯和氛围~
作者: xiaokradio    时间: 2016-7-3 17:03
嗯，很不错的帖子，好好学习一下
作者: lkai    时间: 2016-7-9 22:35
学习，感谢分享
作者: daivder    时间: 2016-8-4 17:09
弱弱问一下，这个代码怎么用
作者: xiabulai    时间: 2016-8-5 08:24
谢谢分享
作者: knowbaby    时间: 2016-9-25 20:41
谢谢楼主
作者: sunyin_80    时间: 2016-9-26 11:43
求密码
作者: 人穷貌丑    时间: 2016-11-3 09:02
现在正急需此工具，谢谢
作者: baiqvcel    时间: 2016-11-3 12:22
谢谢分享，好东东，最近正需要这个。
作者: 暗_星    时间: 2016-11-3 21:42
好资料，谢谢分享
作者: 冉冉升起liu    时间: 2016-11-7 12:54
学习下，谢谢分享
作者: 1989xing    时间: 2016-12-21 14:58
多谢分享！
作者: zhang2185    时间: 2017-4-14 11:46
偶真幸运哦...
作者: lsj0734    时间: 2017-7-9 09:14
非常非常感谢
作者: yx1991    时间: 2017-7-9 20:42
很强大
作者: linty2017    时间: 2017-7-9 23:44
求解压密码
作者: tuqiang    时间: 2017-7-11 16:32
不太会用
作者: 13993359550    时间: 2017-7-11 19:31
学习学习，谢谢
作者: djf454473376    时间: 2017-8-17 19:44
太好了，写的棒棒棒棒的
作者: wgy543    时间: 2017-9-1 11:54
那改的是什么标准
作者: chuangfutb    时间: 2018-1-11 19:46
谢谢分享！
作者: chuangfutb    时间: 2018-1-11 19:49
谢谢分享！
作者: eap899    时间: 2018-1-12 18:39
英雄所见略同
作者: qxzch    时间: 2018-1-13 14:11
谢谢分享！可以再简化一下
  1. Dim swApp As Object
  2. Sub main()
  3. Set swApp = Application.SldWorks
  4. Set Part = swApp.ActiveDoc
  5.     stdfile = "D:\Templates\绘图标准\GB-2017.sldstd"                '指定绘图标准文件所在的路径
  6.     Part.Extension.LoadDraftingStandard stdfile                     '装载绘图标准文件
  7.     Part.ForceRebuild3 False
  8. End Sub
复制代码
作者: 18796891960    时间: 2018-1-15 17:16
谢谢分享
作者: nizhen6007    时间: 2018-3-9 11:06
感谢分享

作者: yh2010    时间: 2018-4-26 09:57
谢谢分享
作者: wwwerzhou    时间: 2018-5-5 11:49
这个很不错！！！
作者: wwwerzhou    时间: 2018-5-5 11:52
这个是针对工程图的，还是零件图，零件都可以用？
作者: wking2014    时间: 2018-5-23 13:32
这个是可以设置文件地址的吧
作者: 人穷貌丑    时间: 2018-6-4 15:11
谢谢分享
作者: 就砍三刀    时间: 2018-7-11 10:55
为毛还有密码啊？


作者: donggeks    时间: 2018-8-10 09:47
谢谢分享
作者: 天道化身    时间: 2018-8-12 22:10
看一下大神操作
作者: zhengmo    时间: 2018-8-13 20:42
真是好东西，谢谢楼主无私奉献
作者: a8012024    时间: 2018-8-15 06:26
谢谢分享
作者: zmdemer    时间: 2018-8-30 23:12
要密码也是好事呀，有密码更是好事
作者: ldx2030    时间: 2018-9-1 11:04
好帖子，就要多顶一下。。。
作者: linkral    时间: 2018-9-1 13:04
大家有没有各种绘图标准可以共享下
作者: tt1699    时间: 2018-9-3 20:15
谢谢，下载试试


作者: chaomogu    时间: 2018-10-16 20:46
试试看效果怎么样
作者: 523491086    时间: 2018-10-23 11:05
感谢楼主分享，看看
作者: jxgawg    时间: 2018-10-26 16:31
好东西，找了好久啦
作者: mylovedada    时间: 2018-10-29 14:09
谢谢啦
作者: wjqngb    时间: 2018-11-13 17:35
学习一下，好复杂的宏
作者: black_moon    时间: 2018-11-14 11:08
谢谢分享
作者: scattie    时间: 2018-11-14 11:40
感謝分享
作者: 设计菜鸟    时间: 2018-11-15 10:29
看看密码
作者: 设计菜鸟    时间: 2018-11-15 10:50
谢谢分享，看看密码。
作者: ningxin4567    时间: 2018-12-5 09:35
密码是啥
作者: 风中de沙    时间: 2019-1-6 13:42
好东西，谢谢分享!

作者: wangxuebin83    时间: 2019-1-8 09:35
.............................................
作者: flooding    时间: 2019-1-25 11:44
非常感谢
作者: kaixinmeihua    时间: 2019-1-25 14:45
请问解压缩密码是多少，谢谢！

作者: kaixinmeihua    时间: 2019-1-25 14:55
回复后已看到密码：111，谢谢分享！
作者: de0830    时间: 2019-2-19 19:04
谢谢了
作者: a8012024    时间: 2019-2-20 06:27
谢谢分享！！！！！！！
作者: guyingmfg    时间: 2019-2-26 16:33
正需要，谢谢



欢迎光临 iCAx开思网 (https://www.icax.org/) Powered by Discuz! X3.3