宏求助 另存宏

我现在有个另存宏的代码

Dim swApp As Object
Dim Part As Object
Dim Filename As String
Dim No As Integer
Dim Title As String
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Filename = Part.GetPathName()
No = Len(Filename)
Filename = Left(Filename, No - 7)
Part.SaveAs2 Filename & ".IGS", 0, True, False
Title = Part.GetTitle
Set Part = Nothing
swApp.CloseDoc Title
'X = MsgBox("输出IGS文件在SW工程图同一文件夹", 0)
End Sub



将零件另存为IGS文件，另为我们公司外发的IGS文件要附加材质，能否通过宏，在另存的时候，在原有文件 上加上  -“材质”，将零件的材质提取出来附加到文件名中

材质是在设计树提取,还是属性中提取?如果在属性中，是在自定义中提取还是在配置特定中？

DaveChan 发表于 2016-12-15 11:03
材质是在设计树提取,还是属性中提取?如果在属性中，是在自定义中提取还是在配置特定中？

davechan 我想从设计树提取材料，还望赐教，谢谢

1. Option Explicit
   
2. Dim swApp As Object
   
3. Dim Part As Object
   
4. Dim Filename As String
   
5. Dim Title As String
   
6. Dim sMatName As String
   
7. Dim sMatDB As String
   
8. Sub main()
   
9. Set swApp = Application.SldWorks
   
10. Set Part = swApp.ActiveDoc
    
11. Filename = Part.GetPathName()
    
12. Filename = Left(Filename, Len(Filename) - 7)
    
13. If Part.GetType = 1 Then
    
14.     sMatName = Part.GetMaterialPropertyName2(Part.GetActiveConfiguration.Name, sMatDB)
    
15.     If sMatName = "" Then sMatName = "材质未指定"
    
16.     Filename = Filename & "-" & sMatName
    
17. ElseIf Part.GetType = 2 Then
    
18.     Filename = Filename & "-组件图"
    
19. End If
    
20. Part.SaveAs2 Filename & ".IGS", 0, True, False
    
21. Title = Part.GetTitle
    
22. Set Part = Nothing
    
23. 'swApp.CloseDoc Title
    
24. 'X = MsgBox("输出IGS文件在SW工程图同一文件夹", 0)
    
25. End Sub

复制代码

DaveChan 发表于 2016-12-26 08:29

謝謝分享哦~
代碼中的"<" 和  ">"，不能出現在檔名中，要換成其他符號哦~

愛玩家 发表于 2017-1-10 10:35
謝謝分享哦~
代碼中的""，不能出現在檔名中，要換成其他符號哦~

谢谢指正
代码已删除“<”">"