[求助] 钣金另存为DWG，文件名增加自定义属性，命名格式为文件名+材料+板厚+数量

vip0537

钣金另存为DWG，文件名增加自定义属性      原求助帖：

命名格式最好能达到的效果：文件名-材料-板厚-单台用量.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

z460515477