宏-按顺序特征重命名

pyczt

以前搞过一个宏是英文名改中文的,有网友问能不能按顺序特征重命名.正好下载了一个,供大家分享.其中的语名值得学习

1. 'PYCZT2018/5/26下载于https://www.codestack.net
   
2. 'This macro renames all the features in active model in the order, preserving the base names.
   
3. '该宏按顺序重命名活动模型中的所有特征名，保留原基本名称。
   
4. 'Only indices are renamed and the base name is preserved. For example Sketch21 will be renamed to Sketch1 for
   
5. 'the first appearance of the sketch feature.
   
6. '只有索引被重命名，基本名称被保留。例如，对于草图特性的第一次出现，Sketch 21将被重命名为Sketch 1.
   
7. 
   
8. 
   
9. 'Notes注意事项:
   
10. '1.Only features with number at the end will be renamed (e.g. Front Plane will not be renamed to Front Plane1 and My1Feature will not be renamed)
    
11. '只在结尾处有编号的特征将被重命名(例如，Front Plane不会被重命名为Front Plane1，以及My1Feature也不会被重命名)
    
12. '2.Case is ignored (case insensitive search)
    
13. '大小写是忽略的
    
14. '3.Only modelling features are renamed (the ones created after the Origin feature)
    
15. '只重命名建模用的特征名(在原点特征之后的)
    
16. 
    
17. '*****************************************************************
    
18. 
    
19. Dim swApp As SldWorks.SldWorks
    
20. Dim swModel As SldWorks.ModelDoc2
    
21. 
    
22. Sub main()
    
23. 
    
24.     Set swApp = Application.SldWorks
    
25.    
    
26.     Set swModel = swApp.ActiveDoc
    
27.    
    
28.     Dim passedOrigin As Boolean
    
29.     passedOrigin = False
    
30.    
    
31.     If Not swModel Is Nothing Then
    
32.    
    
33.         Dim featNamesTable As Object
    
34.         Dim processedFeats As Collection
    
35.         
    
36.         Set featNamesTable = CreateObject("Scripting.Dictionary")
    
37.         Set processedFeats = New Collection
    
38.         
    
39.         featNamesTable.CompareMode = vbTextCompare 'case insensitive
    
40.         
    
41.         Dim swFeat As SldWorks.Feature
    
42.         Set swFeat = swModel.FirstFeature
    
43.         
    
44.         While Not swFeat Is Nothing
    
45.             
    
46.             If passedOrigin Then
    
47.             
    
48.                 If Not Contains(processedFeats, swFeat) Then
    
49.                     processedFeats.Add swFeat
    
50.                     RenameFeature swFeat, featNamesTable
    
51.                 End If
    
52.                
    
53.                 Dim swSubFeat As SldWorks.Feature
    
54.                 Set swSubFeat = swFeat.GetFirstSubFeature
    
55.                
    
56.                 While Not swSubFeat Is Nothing
    
57.                     
    
58.                     If Not Contains(processedFeats, swSubFeat) Then
    
59.                         processedFeats.Add swSubFeat
    
60.                         RenameFeature swSubFeat, featNamesTable
    
61.                     End If
    
62.                     
    
63.                     Set swSubFeat = swSubFeat.GetNextSubFeature
    
64.                     
    
65.                 Wend
    
66.             
    
67.             End If
    
68.             
    
69.             If swFeat.GetTypeName2() = "OriginProfileFeature" Then
    
70.                 passedOrigin = True
    
71.             End If
    
72.             
    
73.             Set swFeat = swFeat.GetNextFeature
    
74.         Wend
    
75.         
    
76.     Else
    
77.         MsgBox "Please open model"
    
78.     End If
    
79. 
    
80. End Sub
    
81. 
    
82. Sub RenameFeature(feat As SldWorks.Feature, featNamesTable As Object)
    
83. 
    
84.     Dim regEx As Object
    
85.     Set regEx = CreateObject("VBScript.RegExp")
    
86.    
    
87.     regEx.Global = True
    
88.     regEx.IgnoreCase = True
    
89.     regEx.Pattern = "(.+?)(\d+)$"
    
90.    
    
91.     Dim regExMatches As Object
    
92.     Set regExMatches = regEx.Execute(feat.Name)
    
93.    
    
94.     If regExMatches.Count = 1 Then
    
95.         
    
96.         If regExMatches(0).SubMatches.Count = 2 Then
    
97.             
    
98.             Dim baseFeatName As String
    
99.             baseFeatName = regExMatches(0).SubMatches(0)
    
100.             
     
101.             Dim nextIndex As Integer
     
102.             
     
103.             If featNamesTable.Exists(baseFeatName) Then
     
104.                 nextIndex = featNamesTable.item(baseFeatName) + 1
     
105.                 featNamesTable.item(baseFeatName) = nextIndex
     
106.             Else
     
107.                 nextIndex = 1
     
108.                 featNamesTable.Add baseFeatName, nextIndex
     
109.             End If
     
110.             feat.Name = baseFeatName & nextIndex
     
111.         End If
     
112.     End If
     
113. 
     
114. End Sub
     
115. 
     
116. Function Contains(coll As Collection, item As Object) As Boolean
     
117.    
     
118.     Dim i As Integer
     
119.    
     
120.     For i = 1 To coll.Count
     
121.         If coll.item(i) Is item Then
     
122.             Contains = True
     
123.             Exit Function
     
124.         End If
     
125.     Next
     
126.    
     
127.     Contains = False
     
128.    
     
129. End Function

复制代码

ryouss

qxzch

gdzsh

gdzsh

pyczt

ryouss

ryouss

a8012024

pyczt