设为首页收藏本站

开启辅助访问切换到宽版

好品数字

好品数字

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

发新帖

查看: 1175|回复: 9

上一主题

下一主题

另存格式宏命令求助

1 主题	33 帖子	359 金币

Rank: 6 Rank: 6 Rank: 6

积分: 1218

楼主

发表于 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机械工程师网

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

回复支持反对

使用道具举报

1 主题	33 帖子	359 金币

Rank: 6 Rank: 6 Rank: 6

积分: 1218

沙发

发表于 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机械工程师网

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

回复支持反对

使用道具举报

发新帖

关闭卷起

关闭卷起

手机版|小黑屋| GMT+8, 2024-5-19 07:18 , Processed in 0.166432 second(s), 32 queries .

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

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

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