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

前段时间发现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：同一模型的意思是：相同檔案名稱及相同的模型組態（配置）。

闷神真的要跪拜，跪舔 ，膜拜

谢谢，很棒

如果是多配制，把多配制里面的代号代替！

谢谢楼主  复制代码

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

版主你好，我用过你的宏设计的很好。如果能够把零件编号（属性里面的编号）同步到图纸页名称就更好了。304088847@qq.com

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

这个宏程序很好用，我有个提议。零件属性里面把图纸编号确定。如何修改这个宏去读取属性里面的图纸编号来重命名图纸名称。

那位大侠修改一下，把读取零件名称改为零件编号。

智商不是一般的高

真是神人！

gdzsh 发表于 2017-8-1 16:18
哈哈  把这个符号直接改为图纸就可以了，不过排序是重0开始的，这么才能从1开始呢？

本來打算回答, 但回答內容可能讓提問者有負面感覺, 看到大大如此高興(哈哈), 那就不掃興了.