设为首页收藏本站

开启辅助访问切换到宽版

好品数字

好品数字

SolidWorks机械工程师网——最大的SolidWorks学习平台»学习社区 › SolidWorks开发与拓展应用 › SolidWorks二次开发（宏，VBA） › 另存格式宏命令求助

发新帖

查看: 1149|回复: 9

上一主题

下一主题

另存格式宏命令求助

3 主题	57 帖子	189 金币

Rank: 4

积分: 510

电梯直达

跳转到指定楼层

楼主

楼主| 发表于 2020-5-9 18:19:16 | 只看该作者回帖奖励

回帖奖励

|倒序浏览 |阅读模式

好品数字

我想在工程图使用宏命令，输出带版本的DWG 和PDF图纸，现在只能输出去掉后缀的图纸，代码如下：
如何增加图纸的版本信息，现在输出的图纸名称为“底座.dwg”怎么修改输出的图纸名称变更为“底座 V1.0.dwg”
V1.0是属性中的版本信息，谢谢。
***********************************************************
Dim swApp As Object

Dim Part As Object
Dim Filename As String
Dim No As Integer
Dim Title As String
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
swModelName = Part.GetPathName
i = InStrRev(swModelName, "\")
Filename = Mid(swModelName, i + 1, Len(swModelName) - i)
Filename = Left(Filename, Len(Filename) - 7)
Part.SaveAs2 Filename & ".DWG", 0, True, False
Part.SaveAs2 Filename & ".PDF", 0, True, False
End Sub

分享到: QQ好友和群 QQ空间 腾讯微博 腾讯朋友

收藏0 转播 教程|习题|模型|技巧0 点赞0 拍砖0

SolidWorks机械工程师网

提示：建议使用谷歌浏览器浏览本网站！如单击这里下载！否则，可能无法下载附件文件！（支持大多数版本的谷歌浏览器，支持360和QQ浏览器的极速模式，即谷歌内核模式，使用IE和Edge浏览器，浏览个别网页以及下载文件时，会误报“***不安全”，此时需要单击“继续访问此不安全站点(不推荐)”才可以继续下载，另外，本网站不含任何不安全的文件，已联系微软公司解决，纯属IE和Edge浏览器误报）

回复

使用道具举报

1 主题	56 帖子	125 金币

Rank: 3 Rank: 3 Rank: 3

积分: 292

沙发

发表于 2020-5-11 14:48:54 | 只看该作者

远东卓越

顶一下，坐等高手！

SolidWorks机械工程师网

提示：建议使用谷歌浏览器浏览本网站！如单击这里下载！否则，可能无法下载附件文件！（支持大多数版本的谷歌浏览器，支持360和QQ浏览器的极速模式，即谷歌内核模式，使用IE和Edge浏览器，浏览个别网页以及下载文件时，会误报“***不安全”，此时需要单击“继续访问此不安全站点(不推荐)”才可以继续下载，另外，本网站不含任何不安全的文件，已联系微软公司解决，纯属IE和Edge浏览器误报）

回复支持反对

使用道具举报

3 主题	57 帖子	189 金币

Rank: 4

积分: 510

板凳

楼主| 发表于 2020-5-11 19:58:13 | 只看该作者

好品数字

等一高手，每次需要手动改文件名就比较麻烦

SolidWorks机械工程师网

回复支持反对

使用道具举报

1 主题	32 帖子	382 金币

Rank: 6 Rank: 6 Rank: 6

积分: 1233

地板

发表于 2020-5-13 22:55:27 | 只看该作者

Dim swApp As Object
Dim Part As Object
Dim Filename As String
Dim No As Integer
Dim Title As String
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
swModelName = Part.GetPathName
i = InStrRev(swModelName, "\")
Filename = Mid(swModelName, i + 1, Len(swModelName) - i)
Filename = Left(Filename, Len(Filename) - 7)
'----------------增加如下代码--------------
On Error Resume Next
Dim swView As SldWorks.View
Dim Version As String
Dim swPart As SldWorks.ModelDoc2
Dim Resvalue As String
Set swView = Part.GetFirstView
Set swView = swView.GetNextView
If swView Is Nothing Then
MsgBox "工程图没有视图"
Exit Sub
End If
Set swPart = swView.ReferencedDocument
Set swPart = swApp.ActiveDoc2
Dim CustPropMgr As SldWorks.CustomPropertyManager
Set CustPropMgr = swPart.Extension.CustomPropertyManager("")
CustPropMgr.Get2 "版本", Version, Resvalue
Filename = Filename + " " + Version
'----------------------------------------------------------------------
Part.SaveAs2 Filename & ".DWG", 0, True, False
Part.SaveAs2 Filename & ".PDF", 0, True, False
End Sub

复制代码

SolidWorks机械工程师网

回复支持反对

使用道具举报

1 主题	32 帖子	382 金币

Rank: 6 Rank: 6 Rank: 6

积分: 1233

5^#

发表于 2020-5-13 22:58:36 | 只看该作者

经典案例图书

Dim swApp As Object
Dim Part As Object
Dim Filename As String
Dim No As Integer
Dim Title As String
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
swModelName = Part.GetPathName
i = InStrRev(swModelName, "\")
Filename = Mid(swModelName, i + 1, Len(swModelName) - i)
Filename = Left(Filename, Len(Filename) - 7)
'----------------增加如下代码--------------
On Error Resume Next
Dim swView As SldWorks.View
Dim Version As String
Dim swPart As SldWorks.ModelDoc2
Dim Resvalue As String
Set swView = Part.GetFirstView
Set swView = swView.GetNextView
If swView Is Nothing Then
MsgBox "工程图没有视图"
Exit Sub
End If
Set swPart = swView.ReferencedDocument
Set swPart = swApp.ActiveDoc2
Dim CustPropMgr As SldWorks.CustomPropertyManager
Set CustPropMgr = swPart.Extension.CustomPropertyManager("")
CustPropMgr.Get2 "版本", Version, Resvalue
Filename = Filename + " " + Version
'----------------------------------------------------------------------
Part.SaveAs2 Filename & ".DWG", 0, True, False
Part.SaveAs2 Filename & ".PDF", 0, True, False
End Sub

复制代码

SolidWorks机械工程师网

回复支持反对

使用道具举报

2 主题	75 帖子	214 金币

Rank: 3 Rank: 3 Rank: 3

积分: 455

6^#

发表于 2020-5-14 12:05:16 | 只看该作者

好好学习，天天向上！

SolidWorks机械工程师网

回复支持反对

使用道具举报

3 主题	57 帖子	189 金币

Rank: 4

积分: 510

7^#

楼主| 发表于 2020-5-15 00:11:16 | 只看该作者

经典案例图书

zhenyx1012 发表于 2020-5-13 22:58

厉害了，运行成功了，谢谢谢谢
我有个问题如果需要运行宏命令后可以指定保存的路径吗？这样的功能可以实现吗？

SolidWorks机械工程师网

回复支持反对

使用道具举报

3 主题	57 帖子	189 金币

Rank: 4

积分: 510

8^#

楼主| 发表于 2020-5-15 00:19:23 | 只看该作者

高手已经回复了，大家都来学习学习吧

SolidWorks机械工程师网

回复支持反对

使用道具举报

3 主题	57 帖子	189 金币

Rank: 4

积分: 510

9^#

楼主| 发表于 2020-5-15 00:22:23 | 只看该作者

运行宏了可以指定输出目录吗？

SolidWorks机械工程师网

回复支持反对

使用道具举报

3 主题	57 帖子	189 金币

Rank: 4

积分: 510

10^#

楼主| 发表于 2020-5-15 00:34:20 | 只看该作者

好品数字

看着大家的回复我很感兴趣啊，我有个想法，那是否可通过宏命令输出“图号”+“代号”+“版本”的文件名称，有没有大师指导一下，谢谢

SolidWorks机械工程师网

回复支持反对

使用道具举报

发新帖

关闭卷起

关闭卷起

手机版|小黑屋| GMT+8, 2024-5-6 05:22 , Processed in 0.173779 second(s), 34 queries .

SolidWorks机械工程师网 ( 鲁ICP备14025122号-2 ) 鲁公网安备 37028502190335号

声明：本网言论纯属发表者个人意见，与本网立场无关。
如涉版权，可发邮件： admin@swbbsc.com

快速回复 返回顶部 返回列表