iCAx开思网

标题: 钣金另存为DWG，文件名增加自定义属性 [打印本页]

作者: Debugg 时间: 2016-9-27 11:13
标题: 钣金另存为DWG，文件名增加自定义属性

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

复制代码

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

作者: Debugg 时间: 2016-9-27 11:14
[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

重发代码

作者: hnsddmax 时间: 2016-9-30 11:07
MARK~~

作者: vip0537 时间: 2020-3-26 14:26
请问这个问题是否解决了？
命名格式最好能达到的效果：文件名-材料-板厚-单台用量.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 时间: 2021-11-12 01:28

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

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

欢迎光临 iCAx开思网 (https://www.icax.org/)