（宏） 重命名工程图图纸名称

前段时间发现SW的另存PDF很好用，于是现在一直把工程图另存为PDF。
为了查阅方便需要把图纸名称改为零件名称，很机械的动作。
这两天看到闷大的獨孤九劍-第二十式：《萬劍朝宗》，只有仰视
找遍资料写了个可以把图纸名称改为零件名称的宏。现在还有缺陷，多张图纸的时候，只有第一次执行才有效果。
还请大家帮忙改改。

1. 
   
2. Dim swApp As Object
   
3. Dim Part As Object
   
4. Dim myDrawingSheet As Object
   
5. Sub main()
   
6. Set swApp = Application.SldWorks
   
7. Set Part = swApp.ActiveDoc
   
8. Set swModel = swApp.GetFirstDocument
   
9. path_name = swModel.GetPathName
   
10. Name = swModel.GetTitle()
    
11. Set myDrawingSheet = Part.GetCurrentSheet()
    
12. myDrawingSheet.SetName Name
    
13. End Sub
    

复制代码

wutong490 发表于 2014-12-1 13:24
1. 纯手工输入的结果见下图

如果是宏修改的话，这个长度可以更长。但是修改就会遇到提示名称过长

配合“同一模型以多頁解說”的代碼如下：（還加上了8樓的渴求及避開一些默認字眼。）

1. Dim PathName As String
   
2. Dim SheetName() As String
   
3. Dim ConfigName As String
   
4. Dim SplittedPathName() As String
   
5. Dim ModelName As String
   
6. 
   
7. Sub main()
   
8. Set swApp = Application.SldWorks
   
9. Set drawing = swApp.ActiveDoc
   
10. If drawing Is Nothing Then
    
11.     MsgBox "阁下是一位小白！"
    
12.     Exit Sub
    
13. End If
    
14. If drawing.GetType <> 3 Then Exit Sub
    
15. SheetName = drawing.GetSheetNames
    
16. SheetCount = drawing.GetSheetCount
    
17. For i = 0 To SheetCount - 1
    
18.     drawing.ActivateSheet SheetName(i)
    
19.     Set swSheet = drawing.GetCurrentSheet
    
20.     swSheet.SetName "$$" & i
    
21. Next
    
22. SheetName = drawing.GetSheetNames
    
23. For i = 0 To SheetCount - 1
    
24.     drawing.ActivateSheet SheetName(i)
    
25.     Set swView = drawing.GetFirstView.GetNextView
    
26.     PathName = swView.GetReferencedModelName
    
27.     ConfigName = swView.ReferencedConfiguration
    
28.     SplittedPathName = Split(PathName, "")
    
29.     ModelName = SplittedPathName(UBound(SplittedPathName))
    
30.     ModelName = Left(ModelName, Len(ModelName) - 7)
    
31.     Set swSheet = drawing.GetCurrentSheet
    
32.     If ConfigName = "Default" Or ConfigName = "默认" Or ConfigName = "預設" Then
    
33.         ThisSheetName = ModelName
    
34.     Else
    
35.         ThisSheetName = ModelName & ">>" & ConfigName
    
36.     End If
    
37.     swSheet.SetName ThisSheetName
    
38.     CurrentSheetName = swSheet.GetName
    
39.     c = 1
    
40.     While CurrentSheetName <> ThisSheetName
    
41.         ThisSheetName = ThisSheetName & ":" & c
    
42.         swSheet.SetName ThisSheetName
    
43.         CurrentSheetName = swSheet.GetName
    
44.         c = c + 1
    
45.     Wend
    
46. Next
    
47. SheetName = drawing.GetSheetNames
    
48. drawing.ActivateSheet SheetName(0)
    
49. End Sub
    

复制代码

ps：同一模型的意思是：相同檔案名稱及相同的模型組態（配置）。

1. Dim PathName As String
   
2. Dim SheetName() As String
   
3. Dim ConfigName As String
   
4. Dim SplittedPathName() As String
   
5. Dim ModelName As String
   
6. 
   
7. Sub main()
   
8. Set swapp = Application.SldWorks
   
9. Set drawing = swapp.ActiveDoc
   
10. If drawing.GetType <> 3 Then Exit Sub
    
11. SheetName = drawing.GetSheetNames
    
12. SheetCount = drawing.GetSheetCount
    
13. For i = 0 To SheetCount - 1
    
14.     drawing.ActivateSheet SheetName(i)
    
15.     Set swSheet = drawing.GetCurrentSheet
    
16.     swSheet.SetName "$$$$$$" & i
    
17. Next
    
18. SheetName = drawing.GetSheetNames
    
19. For i = 0 To SheetCount - 1
    
20.     drawing.ActivateSheet SheetName(i)
    
21.     Set swView = drawing.GetFirstView.GetNextView
    
22.     PathName = swView.GetReferencedModelName
    
23.     ConfigName = swView.ReferencedConfiguration
    
24.     SplittedPathName = Split(PathName, "")
    
25.     ModelName = SplittedPathName(UBound(SplittedPathName))
    
26.     ModelName = Left(ModelName, Len(ModelName) - 7)
    
27.     Set swSheet = drawing.GetCurrentSheet
    
28.     swSheet.SetName ModelName & ":" & ConfigName
    
29. Next
    
30. SheetName = drawing.GetSheetNames
    
31. drawing.ActivateSheet SheetName(0)
    
32. End Sub

复制代码

試下這段代碼.

Francis 发表于 2014-9-5 22:00
試下這段代碼.

非常感谢
测试了 很好用

Francis 发表于 2014-9-5 22:00
試下這段代碼.

"$$$$$$" & i
闷人思维缜密

Francis 发表于 2014-9-5 22:00
試下這段代碼.

厉害，只能仰望。

找不出有什么毛病呀。。

谢谢各位版大，分享

楼主这个怎么设置的啊

ac250626 发表于 2014-11-30 16:59
楼主这个怎么设置的啊

请在工程图状态下实用  2楼闷大的宏

Francis 发表于 2014-9-5 22:00
試下這段代碼.

这个是怎么回事啊焖大侠
到这里就不行了，