求助！工程图转PDF档的时候增加，PDF文件名增加版本属性。

KEMIRWU · 发表于 2021-8-10 17:30:19

经典图书

可以从配置特定里面读到属性，不能从自定义里面读到属性。

补充内容 (2021-8-10 20:45):
3D文件如果是打开的状态下，宏失效了。

tg000057 · 发表于 2021-8-10 17:34:20

KEMIRWU 发表于 2021-8-10 16:58
卡到这个步骤了。

检查一下上一句配置名称“默认”，对应的模型有没有此配置。因为这一句报错应该只有配置名对不上才会出现，如果不是这个情况，我就不知道了！

tg000057 · 发表于 2021-8-11 10:43:25

经典图书

KEMIRWU 发表于 2021-8-10 17:30
可以从配置特定里面读到属性，不能从自定义里面读到属性。

补充内容 (2021-8-10 20:45):

如果是自定义的配置用“”，这个逻辑我也不明白是为什么，然后3D文件打开宏失效，那么关闭3D文件宏就可以正常运行吗？我觉得还是检查一下是不是其他的原因。

KEMIRWU · 发表于 2021-8-25 15:18:34

Public swApp As SldWorks.SldWorks
Public swModel As SldWorks.ModelDoc2
Public Filepath, NewFilepath As String
Public A1, A2, A3, oldName As String
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Filepath = swModel.GetPathName()
Set swDraw = swModel
Get_P
oldName = Left(Filepath, Len(Filepath) - 7) + "-" + "*" + ".pdf"
If Dir(oldName) <> "" Then Kill oldName '删除原文件
NewFilepath = Left(Filepath, Len(Filepath) - 7) + "-" + A1 + "-" + A2 + ".pdf"
swDraw.SaveAs3 NewFilepath, 0, 0
End Sub
Public Function Get_P() '获取零件属性
Dim PathName As String
Dim swNameA As String
PathName = Left(Filepath, Len(Filepath) - 6) '文件路径去后缀
PathName = PathName + "sldprt"
swNameA = Dir(PathName, vbDirectory)
If Not swNameA = Empty Then
Set swModel = swApp.OpenDoc6(PathName, 1, 1, "", 0, 0) '静默打开文件
GoTo ss
End If
PName = Left(Filepath, Len(Filepath) - 6) '文件路径去后缀
PName = PathName + "SLDASM"
swNameA = Dir(PathName, vbDirectory)
If Not swNameA = Empty Then
Set swModel = swApp.OpenDoc6(PathName, 2, 1, "", 0, 0) '静默打开文件
Else
Exit Function
End If
ss:
A1 = Get_Property_value(swModel, "Material")
A2 = Get_Property_value(swModel, "Description")
End Function
Public Function Get_Property_value(swDoc As ModelDoc2, Property_Name As String) As String
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim val As String '属性值
Dim valout As String '属性评估值
Dim bool As Boolean
Set swModelDocExt = swDoc.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")
bool = swCustProp.Get4(Property_Name, False, val, valout)
If InStr(1, val, Chr(168), vbTextCompare) = 0 Then '如果属性值中含有引号，则取属性评估值
Get_Property_value = valout
Else
Get_Property_value = val
End If
End Function

复制代码

KEMIRWU · 发表于 2021-8-25 15:19:52

经典案例图书

KEMIRWU 发表于 2021-8-25 15:18

总体这个是对的，但是宏有BUG，如果你的属性是空值，输出的是属性参数名。

KEMIRWU · 发表于 2021-8-25 16:43:51

KEMIRWU 发表于 2021-8-25 15:19
总体这个是对的，但是宏有BUG，如果你的属性是空值，输出的是属性参数名。

只读2D文件不能有作用。

懒懒的高贵 · 发表于 2023-2-17 11:37:11

经典案例图书

很不错，顶一下！

haq013826 · 发表于 2023-5-30 13:53:53

Allate 发表于 2020-11-27 11:07
我来献个丑，不知道行不行，先试试吧。
Option Explicit
Dim swApp As SldWorks.SldWorks

这个真不错，思路可以借用到转存其他格式上，

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

求助！工程图转PDF档的时候增加，PDF文件名增加版本属性。

最佳新人

活跃会员

热心会员

宣传达人

灌水之王

突出贡献