钣金另存为DWG，文件名增加自定义属性

1. <span style="line-height: 1.5;">Dim swApp As Object</span>

复制代码

根据论坛上其它大大代码更改，实现导出平板形式文件名增加图号，如还想增加其他自定义属性如材质、料厚等，如何修改代码。

[code]Dim swApp As Object
Dim Part As Object
Dim longstatus As Long
Dim swModel As Object
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim val As String
Dim valout As String
Dim swModelName As String
Dim FilePath As String
Dim value As Boolean
Dim sheet_name        As String
Dim boolstatus          As Boolean
Dim swDrawingDoc As SldWorks.DrawingDoc
Dim swSheet As SldWorks.Sheet

Sub main()


Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
On Error Resume Next

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

' ��取出零件屬性物料編號之值~~~~~~~~~~
    Dim Path_N As String
    Dim X_Path_Name As String
    Set swSheet = swModel.GetCurrentSheet
    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("图号", False, val, valout) 'val:图号值

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
swModelName = swModel.GetPathName      '读取当前SW模型文档名(含路径)
FilePath = Left(swModelName, Len(swModelName) - 7) + val + "展开图.dwg" '定义工程图名
'value = swModel.ExportFlatPatternView(FilePath, swExportFlatPatternOption_None)  保留折弯线
value = swModel.ExportFlatPatternView(FilePath, swExportFlatPatternOption_RemoveBends)     '无折弯线
End Sub


重发代码

MARK~~

请问这个问题是否解决了？
命名格式最好能达到的效果：文件名-材料-板厚-单台用量.dwg





Dim swApp As Object
Dim Part As Object
Dim longstatus As Long
Dim swModel As Object
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim val As String
Dim valout As String
Dim swModelName As String
Dim FilePath As String
Dim value As Boolean
Dim sheet_name        As String
Dim boolstatus          As Boolean
Dim swDrawingDoc As SldWorks.DrawingDoc
Dim swSheet As SldWorks.Sheet

Sub main()


Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
On Error Resume Next

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

' ��取出零件屬性物料編號之值~~~~~~~~~~
    Dim Path_N As String
    Dim X_Path_Name As String
    Set swSheet = swModel.GetCurrentSheet
    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("代号", False, val, valout) 'val:图号值

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
swModelName = swModel.GetPathName      '读取当前SW模型文档名(含路径)
FilePath = Left(swModelName, Len(swModelName) - 7) + val + "展开图.dwg" '定义工程图名
'value = swModel.ExportFlatPatternView(FilePath, swExportFlatPatternOption_None)  保留折弯线
value = swModel.ExportFlatPatternView(FilePath, swExportFlatPatternOption_RemoveBends)     '无折弯线
End Sub




1 上面坛友的代码这个语句bool = swCustProp.Get4("代号", False, val, valout) 'val:图号值。。。读取的是零件自定义属性第三列 数值/文字表达式栏的值（只能是数值，如果是表达式这里就读不出来），并非第四列里 评估的值
请教各位，如何改写能实现读取  评估的值
2 文件命名语句 FilePath = Left(swModelName, Len(swModelName) - 7) + val + "展开图.dwg" '定义工程图名
是否能实现   新文件名 = 文件名-材料-板厚-单台用量.dwg

Debugg 发表于 2016-9-27 11:14
[code]Dim swApp As Object
Dim Part As Object
Dim longstatus As Long

请问下大哥，把图号改成材质要怎么修改，可以生成 板厚+材质+文件名 吗，是只能文件名在最前面吗，小白不会改啊