工程圖轉DWG PDF 檔名連結零件屬性_宏

ryouss · 发表于 2014-8-24 08:15:30

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

本帖最后由 ryouss 于 2014-8-24 08:29 编辑

功能:
把目前.SLDDRW的文件,依據該文件的路徑名稱存成 DWG,PDF文件,文件名稱為 "零件屬性的料號"_"工程圖圖頁名稱",
如本例零件屬性料號(Part_no)"1234567",工程圖圖頁名稱 "PartA",執行宏后文件名稱為 1234567_PartA .
操作說明:
1. 把零件檔及工程圖檔存在同一文件路徑,如本例 C:/TEST/ .
2. 打開 SLDPRT , SLDDRW 文件,SLDDRW 工程圖設為目前文件,執行 main() 宏.

執行宏之前的文件:

執行宏之後的文件:

零件自訂屬性:
屬性.jpg

編程:

Dim swApp As Object
Dim Part As Object
Dim longstatus As Long
Dim swModel As ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim val As String
Dim valout As String
Dim bool As Boolean
Dim sheet_name       As String
Dim boolstatus       As Boolean
Dim swExportPDFData    As SldWorks.ExportPdfData
Dim swDrawingDoc As SldWorks.DrawingDoc
Dim swSheet As SldWorks.Sheet

Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
On Error Resume Next

' 取出工程圖圖頁名稱~~~~~~~~~~
Set swModel = swApp.ActiveDoc
Set swDrawingDoc = swModel
Set swSheet = swDrawingDoc.GetCurrentSheet
sheet_name = swSheet.GetName
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

' 取出零件屬性物料編號之值~~~~~~~~~~
Dim Path_N As String
Dim X_Path_Name As String
Set swSheet = swModel.GetCurrentSheet
Set swExportPDFData = swApp.GetExportFileData(1)
Set swModel = swApp.GetFirstDocument
Path_Name = swModel.GetPathName '目前零件檔案的路徑及名稱.SLPRT
Set swModelDocExt = swModel.Extension ' Get the custom property data
Set swCustProp = swModelDocExt.CustomPropertyManager("")
bool = swCustProp.Get4("part_no", False, val, valout) 'val:物料編號之值

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

' 轉成 DWG 及 PDF 檔~~~~~~~~~~~~~
Path_N = Left(Path_Name, Len(Path_Name) - 7)  '取出目前檔案的路徑及名稱(不含副檔名)
For i = 1 To 2
      Select Case i
      Case 1 'save "DWG" file
         X_Path_Name = val & "_" & sheet_name & ".DWG"
      Case 2 'save "PDF" file
         X_Path_Name = val & "_" & sheet_name & ".PDF"
      End Select
longstatus = Part.SaveAs3(X_Path_Name, 0, 0) '儲存 DWG,PDF之文件
Next
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

End Sub

test.zip (105.26 KB, 下载次数: 95)

qiminger · 发表于 2014-8-24 08:47:55

支持梁老师助人，分享方法，谢谢~~

ltq59 · 发表于 2014-8-24 10:39:22

收藏，感谢梁兄分享

lushanyao · 发表于 2014-8-24 21:13:49

谢谢分享，楼主辛苦！

caption_cn · 发表于 2014-8-25 08:53:18

使用梁大附件里的零件及工程图未成功。取得part_no的值为空
看到这个零件是用繁体版建立的，所以就自己又建立了一个新的零件来测试
结果OK
分析结果SW 在取part_no值的时候会考虑配置的问题，虽然这两个文件都没有配置，取值的时候也没有指定配置
那么简体系统就会使用“默认”这一名词。而梁大的版本是繁体“预设” 所以会不成功。
将梁大的Part_A里的繁体“预设”更改为“默认”再次测试
结果OK
再谢梁大

Solidworks 2014 Sp3 简体64位版
Win7 64位旗舰版

ahlek1971 · 发表于 2014-9-2 06:55:55

下载了，梁楼主。。

caption_cn · 发表于 2014-10-24 09:45:58

本帖最后由 caption_cn 于 2014-10-24 09:48 编辑

梁大发现严重问题了
Set swModel = swApp.GetFirstDocument
这句的使用貌似有问题。
现象是这样的。
打开工程图A 运行程序没有问题。
在不关闭工程图A的情况下。直接打开工程图B，运行结果取值是零件A的，不是零件B的。

如果随便打开一个零件X，零件Y
再打开工程图A
运行程序取值是零件X的。
关闭X，再运行
运行程序取值是零件Y的。
----------------------------------
也就是说取值是窗口菜单下第一个文件的里的值。而不是当前编辑文件里的值。
上次使用时打开一个用一个，关一个。所以没有发现。

ryouss · 发表于 2014-10-24 14:28:39

caption_cn 发表于 2014-10-24 09:45 static/image/common/back.gif
, u4 k$ J+ z9 q: _梁大发现严重问题了
( ]6 C. u! m) G9 [ Set swModel = swApp.GetFirstDocument+ f0 Q H6 s. X% N( J
这句的使用貌似有问题。

把問題模糊化複雜化了,
工程圖和零件圖本來就是要一對一啟用,簡單明瞭對應著,
開了好些工程圖和零件圖,電腦哪曉得是哪個工程圖要對應哪個零件圖,
當然也不是說不能做,而是編成就要考慮複雜了,
要知道開了哪些工程圖零件圖,現在又是要執行哪個零件....

caption_cn · 发表于 2014-10-24 15:09:14

ryouss 发表于 2014-10-24 14:28 static/image/common/back.gif
1 S( g1 x4 |2 N% C2 u把問題模糊化複雜化了,6 A0 c9 ^& L' i
工程圖和零件圖本來就是要一對一啟用,簡單明瞭對應著,- y) O; u3 f: d) J
開了好些工程圖和零件圖, ...

梁大可能是我没说清楚
GetFirstDocument 在 API里的解释是Gets the document opened first in this SolidWorks session.
也就是说是SW打开的第一个文件。
另外
我的理解是每页工程图都会对应一个模型或者是这张工程图插入的第一个模型
此时在工程图注解里填入“$PRPSHEET:"物料号" 引用的就是这个工程图对应一个模型或者是这张工程图插入的第一个模型的自定义属性。

可我在API里就是得不到这个属性。

byrhxj · 发表于 2014-10-24 16:33:42

梁老师，你这个对于装配体工程图会有效吗？如果是装配体又该怎么办呢？

大鹿 · 发表于 2014-10-24 19:09:21

请恕小弟多言。
梁兄提供了一个好开端给大家思考方向。
敬请各位不要用面对客户服务的态度，提出诸多要求。
是不是应该先尝试自行深化代码，再一同研习，集思广益。

小弟不才，尝试修改一下，原理是直接从工程图的第二个视图获取模型（因为第一个视图是图页本身）
Set swModel = swApp.GetFirstDocument
改为
Set swModel = swDrawingDoc.GetFirstView.GetNextView.GetReferencedModelName

劳烦各位测试一下。

byrhxj · 发表于 2014-10-26 20:43:21

鹿兄所言极是，是小弟要求太多了。不过却有尝试深化代码，想从零件和装配体中获取配置特定属性，现在却遇到装配体不能获取的困恼，所以才上来询问问题的处理方法。您的代码初步测试了一下，好像不可以。待有空在细看可以不可以。

caption_cn · 发表于 2014-10-27 15:55:43

本帖最后由 caption_cn 于 2014-10-27 17:56 编辑

新版本来了
主要就是针对自定义属性读取的模型文件进行定位的修改

思路是使用 GetReferencedModelName 获取当前工程图第一个视图对应的模型
ReferencedConfiguration 获得对应配置。
然后再获取模型里需要的自定义属性
因为不常搞，又参考了很多不同的例子所以定义比较多，有不少没用的，没有再整理。
还在测试中，请老大们赐教。
'================
'此程序运行时将当前显示的工程图页按一定规律命名后转换成 PDF 和 DWG 文件输出到指定文件夹。
'命名规则
'当前工程图第一个视图对应的模型内的自定义属性"物料号" + "_" + 当前工程图名称
'自动区分零件还是装配体
'支持配置
'SLDDRW_DWG_PDF.swp
'================
Dim swApp    As Object
Dim Part    As Object
Dim swModel                   As ModelDoc2
Dim swModelDocExt             As ModelDocExtension
Dim swModelDocExt1             As ModelDocExtension
Dim swCustProp                As CustomPropertyManager
Dim val       As String
Dim valout    As String
Dim bool    As Boolean
Dim sheet_name                As String
Dim boolstatus                As Boolean
Dim swExportPDFData          As SldWorks.ExportPdfData
Dim swDrawingDoc             As SldWorks.DrawingDoc
Dim swSheet                   As SldWorks.Sheet
Dim swView                   As SldWorks.View
Dim swSelMgr                   As SldWorks.SelectionMgr
Dim swDrawModel                As SldWorks.ModelDoc2
Dim sModelName                As String
Dim sMoldlCofn                As String
Dim tmpPath As String
Dim tmpObj As SldWorks.ModelDoc2
Dim boolstat As Boolean
Dim swcomponent As SldWorks.Component2
Dim AssemblyTitle As String
Dim errors As Long
Dim warnings As Long
Dim lErrors          As Long
Dim lWarnings          As Long
Dim Path_N As String
Dim X_Path_Name As String

Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
On Error Resume Next

val = ""
sheet_name = ""

'读取当前工程图
Set swModel = swApp.ActiveDoc
Set swDrawingDoc = swModel
Set swSheet = swDrawingDoc.GetCurrentSheet
Set swExportPDFData = swApp.GetExportFileData(1)

'读取第一视图对应模型名称
Set swView = swDrawingDoc.GetFirstView '获取第一个视图，实际上是当前页
sheet_name = swView.GetName2
Set swView = swView.GetNextView       '获取下一个视图，就是实际插入第一个模型的视图
sModelName = swView.GetReferencedModelName '获取改视图对应模型
sMoldlCofn = swView.ReferencedConfiguration  '获取改视图对应配置名称

'区别零件还是装配体，打开方式不同
sModelName = StrConv(sModelName, vbLowerCase)
If InStr(sModelName, "sldprt") = 0 Then
Set tmpObj = swApp.OpenDoc6(sModelName, swDocASSEMBLY, 0, "", errors, warnings) '装配体时运行
Else
Set tmpObj = swApp.OpenDoc6(sModelName, swDocPART, 0, "", errors, warnings)  '零件时运行
End If

' 读取物料号缺省是“默认”API 函数识别错误
Set swModelDocExt1 = tmpObj.Extension
If sMoldlCofn = "默认" Then
Set swCustProp = swModelDocExt1.CustomPropertyManager("") ' 缺省是“默认”只能留空填获取的sMoldlCofn不正确。
bool = swCustProp.Get4("物料号", False, val, valout)  'val：物料号
If val = "" Then
      Set swCustProp = swModelDocExt1.CustomPropertyManager("默认")
      bool = swCustProp.Get4("物料号", False, val, valout)  'val：物料号
End If

Else
Set swCustProp = swModelDocExt1.CustomPropertyManager(sMoldlCofn)
bool = swCustProp.Get4("物料号", False, val, valout)  'val：物料号
End If

'  转换输出只保存当前显示页
Set swModelDocExt = swModel.Extension
boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, sheet_name)

X_Path_Name = "D:\00临时输出文件夹00\" & val & "_" & sheet_name & ".DWG"
boolstatus = swModelDocExt.SaveAs(X_Path_Name, 0, 0, swExportPDFData, lErrors, lWarnings)

X_Path_Name = "D:\00临时输出文件夹00\" & val & "_" & sheet_name & ".PDF"
boolstatus = swModelDocExt.SaveAs(X_Path_Name, 0, 0, swExportPDFData, lErrors, lWarnings)

tmpObj.Close
swModel.Close
swDrawModel.Close
End Sub

再次感谢梁大

byrhxj · 发表于 2014-10-27 22:19:01

caption_cn兄果然厉害，不常搞还搞得这么好，这个打开方式我一直没找到关键还是懒。代码经测试OK！感谢您和梁大提供的代码思路，谢谢。

Torry2010 · 发表于 2014-11-15 13:30:15

以上的老师太厉害了，看不懂代码！

cjhya · 发表于 2014-11-16 17:23:52

谢谢楼主分享

lider2010 · 发表于 2014-11-18 12:52:10

谢谢给位大师的分享，从中学了不少东西啊

hidingman · 发表于 2015-8-15 17:29:37

感謝梁老師協助正是我需要的

:handshake

hidingman · 发表于 2015-8-20 21:14:44

請教怎麼改

Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set swModel = swApp.ActiveDoc
Set swDrawingDoc = swModel
Set swView = swDrawingDoc.GetFirstView
sheet_name = swView.GetName2
X_Path_Name = "C:\Temp\" & sheet_name & ".PDF"
longstatus = Part.SaveAs3(X_Path_Name, 0, 0)
End Sub
如上儲存後會顯示在C:\Temp\圖頁1.pdf
請問sheet_name 如何改成零件名如果要加註 _圖頁比例又當怎麼改
如: A123_A4

		自动登录	找回密码
密码			注册

通知

[分享] 工程圖轉DWG PDF 檔名連結零件屬性_宏

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

评分

点评

点评

点评

点评

浏览过的版块