如何將兩組不同功能的程式碼改成一組程式碼?

ㄚ水

請問我要如何將兩組不同功能的程式碼改成一組程式碼?

如下 : 一組是零件檔的轉碼 一組是組件檔的轉碼
想說是否能整合成一個巨集就可以自行判斷檔案類型後自動使用對用的程式碼

1. Sub JET_零件圖名轉料號_機構_組件()
   
2. 
   
3. Dim swApp As SldWorks.SldWorks
   
4. Dim swModel As SldWorks.ModelDoc2
   
5. Dim aCode As String '機種代碼
   
6. Dim bCode As String '模組代碼
   
7. Dim sapNumber As String '料號總成
   
8. Set swApp = Application.SldWorks '初始化SOLIDWORKS應用程式
   
9. 
   
10. '-------------------------------檢查檔案格式---------------------------------
    
11. 
    
12. Set swModel = swApp.ActiveDoc '設置模型為激活的文件
    
13. ' 檢查當前文件檔案格式是否正確
    
14. 'If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then '此為工程圖檔
    
15. 'If (swModel Is Nothing) Or (swModel.GetType <> swDocPART) Then '此為零件檔
    
16. If (swModel Is Nothing) Or (swModel.GetType <> swDocASSEMBLY) Then '此為組合件檔
    
17. 
    
18. '向用戶發送錯誤訊息
    
19. swApp.SendMsgToUser ("【 僅 適 用 於 組 件 檔 】")
    
20. 
    
21. 
    
22. ' 如果沒有加載模型，則退出
    
23. Exit Sub
    
24. 
    
25. End If
    
26. 
    
27. '---------------------------------------------------------------------------
    
28. 
    
29. Set swApp = Application.SldWorks
    
30. Set swModel = swApp.ActiveDoc
    
31. 
    
32. 'Get the current file name
    
33. Dim fileName As String
    
34. ' 取得當前開啟的檔案名稱(含路徑)
    
35. fileName = swModel.GetPathName()
    
36. ' 取得檔案名稱(含副檔名)
    
37. fileName = Right(fileName, Len(fileName) - InStrRev(fileName, ""))
    
38. 
    
39. 'Get the aCode(機種代碼截取)
    
40. aCode = Left(fileName, InStr(fileName, "#") - 3)
    
41. ' aCode(機種代碼轉換)
    
42. Select Case aCode
    
43. 
    
44. Case "共用型選項": aCode = "1100"
    
45. Case "5500V": aCode = "1101"
    
46. Case "5500MLR": aCode = "1102"
    
47. Case "5500MLB": aCode = "1103"
    
48. Case "5500SLR": aCode = "1104"
    
49. Case "5500SLB": aCode = "1105"
    
50. Case "5500SLGR": aCode = "1106"
    
51. 
    
52. Case Else: aCode = "****"
    
53. End Select
    
54. 
    
55. 'Get the bCode(模組碼截取)
    
56. bCode = Mid(fileName, InStr(fileName, "#") - 2, 2)
    
57. 
    
58. 'Generate the SAP number(料號組合)
    
59. sapNumber = aCode & bCode & "**"
    
60. 
    
61. 
    
62. ' 建立自訂屬性值
    
63. Dim sConfigName As String
    
64. sConfigName = "預設" ' *****設定要寫入的組態名稱*****
    
65. Dim Configs As Variant
    
66. Configs = swApp.ActiveDoc.GetConfigurationNames()
    
67. 
    
68. ' 檢查是否有現有的組態名稱
    
69. If IsArray(Configs) Then
    
70. For i = 0 To UBound(Configs)
    
71. If Configs(i) = sConfigName Then
    
72. ' 如果已存在，將 sConfigName 設定為現有的組態名稱
    
73. sConfigName = Configs(i)
    
74. Exit For
    
75. End If
    
76. Next
    
77. End If
    
78. 
    
79. Dim retval As Long
    
80. '刪除"SAP料號"欄
    
81. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "SAP料號")
    
82. '新增"SAP料號"欄
    
83. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "SAP料號", swCustomInfoText, sapNumber)
    
84. 
    
85. '刪除"加工方法"欄
    
86. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "加工方法")
    
87. '新增"加工方法"欄
    
88. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "加工方法", swCustomInfoText, fCode)
    
89. 
    
90. '刪除"階層"欄
    
91. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "階層")
    
92. '新增"階層"欄
    
93. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "階層", swCustomInfoText, gCode)
    
94. 
    
95. 
    
96. '寫入作者
    
97. Set swApp = Application.SldWorks
    
98. Set Part = swApp.ActiveDoc
    
99. Part.SummaryInfo(swSumInfoAuthor) = "XXX"
    
100. 
     
101. 
     
102. '刪除全部屬性
     
103. Set swApp = Application.SldWorks
     
104. Set Part = swApp.ActiveDoc
     
105. p = "" '指定模型組態名稱 ，如果要刪自訂則空白
     
106. k = Part.GetCustomInfoNames2(p)
     
107. For i = 0 To UBound(k)
     
108. Part.DeleteCustomInfo2 p, k(i)
     
109. Next
     
110. 
     
111. 
     
112. '-------------------------------------------------------------------------
     
113. '樹狀結構顯示
     
114. Set swApp = _
     
115. Application.SldWorks
     
116. Set Part = swApp.ActiveDoc
     
117. Set intance = Part.FeatureManager
     
118. 
     
119. '顯示特徵名稱
     
120. intance.ShowFeatureName = True
     
121. '顯示特徵描述
     
122. intance.ShowFeatureDescription = False
     
123. 
     
124. '顯示零組件名稱
     
125. intance.ShowComponentNames = True
     
126. '顯示零組件描述
     
127. intance.ShowComponentDescriptions = True
     
128. '顯示零組件模型組態名稱
     
129. intance.ShowComponentConfigurationNames = True
     
130. '顯示零組件模型組態描述
     
131. intance.ShowComponentConfigurationDescriptions = False
     
132. '顯示顯示狀態名稱
     
133. intance.ShowDisplayStateNames = False
     
134. 
     
135. '顯示特徵
     
136. intance.ViewFeatures = True
     
137. 
     
138. '------------------------------------------------------------------------------
     
139. 
     
140. '重新整理
     
141. Set Part = swApp.ActiveDoc
     
142. boolstatus = Part.EditRebuild3()
     
143. 
     
144. 
     
145. ' 顯示成功訊息
     
146. 'MsgBox "█ SAP 料號已寫入 █"
     
147. 
     
148. 
     
149. End Sub

複製代碼

1. Sub JET_零件圖名轉料號_機構_零件()
   
2. 
   
3. Dim swApp As SldWorks.SldWorks
   
4. Dim swModel As SldWorks.ModelDoc2
   
5. Dim aCode As String '機種代碼
   
6. Dim bCode As String '加工代碼
   
7. Dim cCode As String '版次代碼
   
8. Dim dCode As String '模組代碼
   
9. Dim eCode As String '流水碼
   
10. Dim fCode As String '加工碼
    
11. Dim gCode As String '階層碼
    
12. Dim sapNumber As String '料號總成
    
13. Set swApp = Application.SldWorks '初始化SOLIDWORKS應用程式
    
14. 
    
15. '-------------------------------檢查檔案格式---------------------------------
    
16. 
    
17. Set swModel = swApp.ActiveDoc '設置模型為激活的文件
    
18. ' 檢查當前文件檔案格式是否正確
    
19. 'If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then '此為工程圖檔
    
20. If (swModel Is Nothing) Or (swModel.GetType <> swDocPART) Then '此為零件檔
    
21. 'If (swModel Is Nothing) Or (swModel.GetType <> swDocASSEMBLY) Then '此為組合件檔
    
22. 
    
23. '向用戶發送錯誤訊息
    
24. swApp.SendMsgToUser ("【 僅 適 用 於 零 件 檔 】")
    
25. 
    
26. 
    
27. ' 如果沒有加載模型，則退出
    
28. Exit Sub
    
29. 
    
30. End If
    
31. 
    
32. '---------------------------------------------------------------------------
    
33. 
    
34. Set swApp = Application.SldWorks
    
35. Set swModel = swApp.ActiveDoc
    
36. 
    
37. 'Get the current file name
    
38. Dim fileName As String
    
39. ' 取得當前開啟的檔案名稱(含路徑)
    
40. fileName = swModel.GetPathName()
    
41. ' 取得檔案名稱(含副檔名)
    
42. fileName = Right(fileName, Len(fileName) - InStrRev(fileName, ""))
    
43. 
    
44. 'Get the aCode(機種代碼截取)
    
45. aCode = Left(fileName, InStr(fileName, "-") - 3)
    
46. ' aCode(機種代碼轉換)
    
47. Select Case aCode
    
48. 
    
49. Case "共用型選項": aCode = "1100"
    
50. Case "5500V": aCode = "1101"
    
51. Case "5500MLR": aCode = "1102"
    
52. Case "5500MLB": aCode = "1103"
    
53. Case "5500SLR": aCode = "1104"
    
54. Case "5500SLB": aCode = "1105"
    
55. Case "5500SLGR": aCode = "1106"
    
56. Case "7700S": aCode = "6666"
    
57. Case "3000SLR": aCode = "1104"
    
58. 
    
59. Case Else: aCode = "****"
    
60. End Select
    
61. 
    
62. 'Get the bCode(加工碼截取)
    
63. bCode = Mid(fileName, InStr(fileName, "-") + 1, 1)
    
64. ' bCode(加工碼轉換)
    
65. Select Case bCode
    
66. Case "D": bCode = "3001"
    
67. Case "C": bCode = "3002"
    
68. Case "M": bCode = "3003"
    
69. Case "L": bCode = "3004"
    
70. Case "P": bCode = "3005"
    
71. Case "A": bCode = "3006"
    
72. Case "S": bCode = "3007"
    
73. Case "U": bCode = "3008"
    
74. Case "B": bCode = "3009"
    
75. Case "R": bCode = "3010"
    
76. Case "Y": bCode = "3011"
    
77. Case "F": bCode = "3012"
    
78. Case "Z": bCode = "3013"
    
79. Case "G": bCode = "3015"
    
80. Case "H": bCode = "3016"
    
81. Case "J": bCode = "3017"
    
82. Case Else: bCode = "****"
    
83. End Select
    
84. 
    
85. 'Get the cCode(版次代碼截取)
    
86. cCode = Mid(fileName, InStr(fileName, "-") + 6, 1)
    
87. ' cCode(版次代碼轉換)
    
88. Select Case cCode
    
89. Case "A": cCode = "01"
    
90. Case "B": cCode = "02"
    
91. Case "C": cCode = "03"
    
92. Case "D": cCode = "04"
    
93. Case "E": cCode = "05"
    
94. Case "F": cCode = "06"
    
95. Case "G": cCode = "07"
    
96. Case "H": cCode = "08"
    
97. Case "I": cCode = "09"
    
98. Case "J": cCode = "10"
    
99. Case "K": cCode = "11"
    
100. Case "L": cCode = "12"
     
101. Case "M": cCode = "13"
     
102. Case "N": cCode = "14"
     
103. Case "O": cCode = "15"
     
104. Case "P": cCode = "16"
     
105. Case "Q": cCode = "17"
     
106. Case "R": cCode = "18"
     
107. Case "S": cCode = "19"
     
108. Case "T": cCode = "20"
     
109. Case "U": cCode = "21"
     
110. Case "V": cCode = "22"
     
111. Case "W": cCode = "23"
     
112. Case "X": cCode = "24"
     
113. Case "Y": cCode = "25"
     
114. Case "Z": cCode = "26"
     
115. Case Else: cCode = "**"
     
116. End Select
     
117. 
     
118. 'Get the dCode(模組碼截取)
     
119. dCode = Mid(fileName, InStr(fileName, "-") - 2, 2)
     
120. 
     
121. 'Get the eCode(流水碼截取)
     
122. eCode = Mid(fileName, InStr(fileName, "-") + 3, 3)
     
123. 
     
124. 'Get the fCode(加工碼截取)
     
125. fCode = Mid(fileName, InStr(fileName, "-") + 1, 1)
     
126. 
     
127. 'Get the gCode(階層碼截取)
     
128. gCode = Mid(fileName, InStr(fileName, "-") + 1, 1)
     
129. ' gCode(階層碼轉換)
     
130. Select Case gCode
     
131. Case "P": gCode = "4"
     
132. Case Else: gCode = "3"
     
133. End Select
     
134. 
     
135. 
     
136. 'Generate the SAP number(料號組合)
     
137. sapNumber = bCode & aCode & dCode & eCode & cCode
     
138. 
     
139. 
     
140. ' 建立自訂屬性值
     
141. Dim sConfigName As String
     
142. sConfigName = "預設" ' *****設定要寫入的組態名稱*****
     
143. Dim Configs As Variant
     
144. Configs = swApp.ActiveDoc.GetConfigurationNames()
     
145. 
     
146. ' 檢查是否有現有的組態名稱
     
147. If IsArray(Configs) Then
     
148. For i = 0 To UBound(Configs)
     
149. If Configs(i) = sConfigName Then
     
150. ' 如果已存在，將 sConfigName 設定為現有的組態名稱
     
151. sConfigName = Configs(i)
     
152. Exit For
     
153. End If
     
154. Next
     
155. End If
     
156. 
     
157. Dim retval As Long
     
158. '刪除"SAP料號"欄
     
159. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "SAP料號")
     
160. '新增"SAP料號"欄
     
161. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "SAP料號", swCustomInfoText, sapNumber)
     
162. 
     
163. '刪除"加工方法"欄
     
164. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "加工方法")
     
165. '新增"加工方法"欄
     
166. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "加工方法", swCustomInfoText, fCode)
     
167. 
     
168. '刪除"階層"欄
     
169. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "階層")
     
170. '新增"階層"欄
     
171. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "階層", swCustomInfoText, gCode)
     
172. 
     
173. 
     
174. '寫入作者
     
175. Set swApp = Application.SldWorks
     
176. Set Part = swApp.ActiveDoc
     
177. Part.SummaryInfo(swSumInfoAuthor) = "XXX"
     
178. 
     
179. 
     
180. '刪除全部屬性
     
181. Set swApp = Application.SldWorks
     
182. Set Part = swApp.ActiveDoc
     
183. p = "" '指定模型組態名稱 ，如果要刪自訂則空白
     
184. k = Part.GetCustomInfoNames2(p)
     
185. For i = 0 To UBound(k)
     
186. Part.DeleteCustomInfo2 p, k(i)
     
187. Next
     
188. 
     
189. 
     
190. '-------------------------------------------------------------------------
     
191. '樹狀結構顯示
     
192. Set swApp = _
     
193. Application.SldWorks
     
194. Set Part = swApp.ActiveDoc
     
195. Set intance = Part.FeatureManager
     
196. 
     
197. '顯示特徵名稱
     
198. intance.ShowFeatureName = True
     
199. '顯示特徵描述
     
200. intance.ShowFeatureDescription = False
     
201. 
     
202. '顯示零組件名稱
     
203. intance.ShowComponentNames = True
     
204. '顯示零組件描述
     
205. intance.ShowComponentDescriptions = True
     
206. '顯示零組件模型組態名稱
     
207. intance.ShowComponentConfigurationNames = True
     
208. '顯示零組件模型組態描述
     
209. intance.ShowComponentConfigurationDescriptions = False
     
210. '顯示顯示狀態名稱
     
211. intance.ShowDisplayStateNames = False
     
212. 
     
213. '顯示特徵
     
214. intance.ViewFeatures = True
     
215. 
     
216. '------------------------------------------------------------------------------
     
217. 
     
218. '重新整理
     
219. Set Part = swApp.ActiveDoc
     
220. boolstatus = Part.EditRebuild3()
     
221. 
     
222. 
     
223. ' 顯示成功訊息
     
224. 'MsgBox "█ SAP 料號已寫入 █"
     
225. 
     
226. 
     
227. End Sub

複製代碼

Francis

1. Sub JET_零件圖名轉料號_機構_零件及組件()
   
2. 
   
3. Dim swApp As SldWorks.SldWorks
   
4. Dim swModel As SldWorks.ModelDoc2
   
5. Dim aCode As String '機種代碼
   
6. Dim bCode As String '加工代碼
   
7. Dim cCode As String '版次代碼
   
8. Dim dCode As String '模組代碼
   
9. Dim eCode As String '流水碼
   
10. Dim fCode As String '加工碼
    
11. Dim gCode As String '階層碼
    
12. Dim sapNumber As String '料號總成
    
13. Set swApp = Application.SldWorks '初始化SOLIDWORKS應用程式
    
14. 
    
15. '-------------------------------檢查檔案格式---------------------------------
    
16. 
    
17. Set swApp = Application.SldWorks
    
18. Set swModel = swApp.ActiveDoc '設置模型為激活的文件
    
19. '*********************************************************
    
20. If swModel.GetType = swDocASSEMBLY Then '此為組合件檔
    
21. 
    
22. 'Get the current file name
    
23. Dim fileName As String
    
24. ' 取得當前開啟的檔案名稱(含路徑)
    
25. fileName = swModel.GetPathName()
    
26. ' 取得檔案名稱(含副檔名)
    
27. fileName = Right(fileName, Len(fileName) - InStrRev(fileName, ""))
    
28. 
    
29. 'Get the aCode(機種代碼截取)
    
30. aCode = Left(fileName, InStr(fileName, "-") - 3)
    
31. ' aCode(機種代碼轉換)
    
32. Select Case aCode
    
33. 
    
34. Case "共用型選項": aCode = "1100"
    
35. Case "5500V": aCode = "1101"
    
36. Case "5500MLR": aCode = "1102"
    
37. Case "5500MLB": aCode = "1103"
    
38. Case "5500SLR": aCode = "1104"
    
39. Case "5500SLB": aCode = "1105"
    
40. Case "5500SLGR": aCode = "1106"
    
41. Case "7700S": aCode = "6666"
    
42. Case "3000SLR": aCode = "1104"
    
43. 
    
44. Case Else: aCode = "****"
    
45. End Select
    
46. 
    
47. 'Get the bCode(加工碼截取)
    
48. bCode = Mid(fileName, InStr(fileName, "-") + 1, 1)
    
49. ' bCode(加工碼轉換)
    
50. Select Case bCode
    
51. Case "D": bCode = "3001"
    
52. Case "C": bCode = "3002"
    
53. Case "M": bCode = "3003"
    
54. Case "L": bCode = "3004"
    
55. Case "P": bCode = "3005"
    
56. Case "A": bCode = "3006"
    
57. Case "S": bCode = "3007"
    
58. Case "U": bCode = "3008"
    
59. Case "B": bCode = "3009"
    
60. Case "R": bCode = "3010"
    
61. Case "Y": bCode = "3011"
    
62. Case "F": bCode = "3012"
    
63. Case "Z": bCode = "3013"
    
64. Case "G": bCode = "3015"
    
65. Case "H": bCode = "3016"
    
66. Case "J": bCode = "3017"
    
67. Case Else: bCode = "****"
    
68. End Select
    
69. 
    
70. 'Get the cCode(版次代碼截取)
    
71. cCode = Mid(fileName, InStr(fileName, "-") + 6, 1)
    
72. ' cCode(版次代碼轉換)
    
73. Select Case cCode
    
74. Case "A": cCode = "01"
    
75. Case "B": cCode = "02"
    
76. Case "C": cCode = "03"
    
77. Case "D": cCode = "04"
    
78. Case "E": cCode = "05"
    
79. Case "F": cCode = "06"
    
80. Case "G": cCode = "07"
    
81. Case "H": cCode = "08"
    
82. Case "I": cCode = "09"
    
83. Case "J": cCode = "10"
    
84. Case "K": cCode = "11"
    
85. Case "L": cCode = "12"
    
86. Case "M": cCode = "13"
    
87. Case "N": cCode = "14"
    
88. Case "O": cCode = "15"
    
89. Case "P": cCode = "16"
    
90. Case "Q": cCode = "17"
    
91. Case "R": cCode = "18"
    
92. Case "S": cCode = "19"
    
93. Case "T": cCode = "20"
    
94. Case "U": cCode = "21"
    
95. Case "V": cCode = "22"
    
96. Case "W": cCode = "23"
    
97. Case "X": cCode = "24"
    
98. Case "Y": cCode = "25"
    
99. Case "Z": cCode = "26"
    
100. Case Else: cCode = "**"
     
101. End Select
     
102. 
     
103. 'Get the dCode(模組碼截取)
     
104. dCode = Mid(fileName, InStr(fileName, "-") - 2, 2)
     
105. 
     
106. 'Get the eCode(流水碼截取)
     
107. eCode = Mid(fileName, InStr(fileName, "-") + 3, 3)
     
108. 
     
109. 'Get the fCode(加工碼截取)
     
110. fCode = Mid(fileName, InStr(fileName, "-") + 1, 1)
     
111. 
     
112. 'Get the gCode(階層碼截取)
     
113. gCode = Mid(fileName, InStr(fileName, "-") + 1, 1)
     
114. ' gCode(階層碼轉換)
     
115. Select Case gCode
     
116. Case "P": gCode = "4"
     
117. Case Else: gCode = "3"
     
118. End Select
     
119. 
     
120. 
     
121. 'Generate the SAP number(料號組合)
     
122. sapNumber = bCode & aCode & dCode & eCode & cCode
     
123. 
     
124. 
     
125. ' 建立自訂屬性值
     
126. Dim sConfigName As String
     
127. sConfigName = "預設" ' *****設定要寫入的組態名稱*****
     
128. Dim Configs As Variant
     
129. Configs = swApp.ActiveDoc.GetConfigurationNames()
     
130. 
     
131. ' 檢查是否有現有的組態名稱
     
132. If IsArray(Configs) Then
     
133. For i = 0 To UBound(Configs)
     
134. If Configs(i) = sConfigName Then
     
135. ' 如果已存在，將 sConfigName 設定為現有的組態名稱
     
136. sConfigName = Configs(i)
     
137. Exit For
     
138. End If
     
139. Next
     
140. End If
     
141. 
     
142. Dim retval As Long
     
143. '刪除"SAP料號"欄
     
144. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "SAP料號")
     
145. '新增"SAP料號"欄
     
146. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "SAP料號", swCustomInfoText, sapNumber)
     
147. 
     
148. '刪除"加工方法"欄
     
149. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "加工方法")
     
150. '新增"加工方法"欄
     
151. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "加工方法", swCustomInfoText, fCode)
     
152. 
     
153. '刪除"階層"欄
     
154. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "階層")
     
155. '新增"階層"欄
     
156. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "階層", swCustomInfoText, gCode)
     
157. 
     
158. 
     
159. '寫入作者
     
160. Set swApp = Application.SldWorks
     
161. Set Part = swApp.ActiveDoc
     
162. Part.SummaryInfo(swSumInfoAuthor) = "XXX"
     
163. 
     
164. 
     
165. '刪除全部屬性
     
166. Set swApp = Application.SldWorks
     
167. Set Part = swApp.ActiveDoc
     
168. p = "" '指定模型組態名稱 ，如果要刪自訂則空白
     
169. k = Part.GetCustomInfoNames2(p)
     
170. For i = 0 To UBound(k)
     
171. Part.DeleteCustomInfo2 p, k(i)
     
172. Next
     
173. 
     
174. 
     
175. '-------------------------------------------------------------------------
     
176. '樹狀結構顯示
     
177. Set swApp = _
     
178. Application.SldWorks
     
179. Set Part = swApp.ActiveDoc
     
180. Set intance = Part.FeatureManager
     
181. 
     
182. '顯示特徵名稱
     
183. intance.ShowFeatureName = True
     
184. '顯示特徵描述
     
185. intance.ShowFeatureDescription = False
     
186. 
     
187. '顯示零組件名稱
     
188. intance.ShowComponentNames = True
     
189. '顯示零組件描述
     
190. intance.ShowComponentDescriptions = True
     
191. '顯示零組件模型組態名稱
     
192. intance.ShowComponentConfigurationNames = True
     
193. '顯示零組件模型組態描述
     
194. intance.ShowComponentConfigurationDescriptions = False
     
195. '顯示顯示狀態名稱
     
196. intance.ShowDisplayStateNames = False
     
197. 
     
198. '顯示特徵
     
199. intance.ViewFeatures = True
     
200. 
     
201. '------------------------------------------------------------------------------
     
202. 
     
203. '重新整理
     
204. Set Part = swApp.ActiveDoc
     
205. boolstatus = Part.EditRebuild3()
     
206. 
     
207. 
     
208. ' 顯示成功訊息
     
209. 'MsgBox "█ SAP 料號已寫入 █"
     
210. 
     
211. End if
     
212. '*********************************************************
     
213. If swModel.GetType = swDocPART Then '此為零件檔
     
214. 
     
215. 'Get the current file name
     
216. Dim fileName As String
     
217. ' 取得當前開啟的檔案名稱(含路徑)
     
218. fileName = swModel.GetPathName()
     
219. ' 取得檔案名稱(含副檔名)
     
220. fileName = Right(fileName, Len(fileName) - InStrRev(fileName, ""))
     
221. 
     
222. 'Get the aCode(機種代碼截取)
     
223. aCode = Left(fileName, InStr(fileName, "#") - 3)
     
224. ' aCode(機種代碼轉換)
     
225. Select Case aCode
     
226. 
     
227. Case "共用型選項": aCode = "1100"
     
228. Case "5500V": aCode = "1101"
     
229. Case "5500MLR": aCode = "1102"
     
230. Case "5500MLB": aCode = "1103"
     
231. Case "5500SLR": aCode = "1104"
     
232. Case "5500SLB": aCode = "1105"
     
233. Case "5500SLGR": aCode = "1106"
     
234. 
     
235. Case Else: aCode = "****"
     
236. End Select
     
237. 
     
238. 'Get the bCode(模組碼截取)
     
239. bCode = Mid(fileName, InStr(fileName, "#") - 2, 2)
     
240. 
     
241. 'Generate the SAP number(料號組合)
     
242. sapNumber = aCode & bCode & "**"
     
243. 
     
244. 
     
245. ' 建立自訂屬性值
     
246. Dim sConfigName As String
     
247. sConfigName = "預設" ' *****設定要寫入的組態名稱*****
     
248. Dim Configs As Variant
     
249. Configs = swApp.ActiveDoc.GetConfigurationNames()
     
250. 
     
251. ' 檢查是否有現有的組態名稱
     
252. If IsArray(Configs) Then
     
253. For i = 0 To UBound(Configs)
     
254. If Configs(i) = sConfigName Then
     
255. ' 如果已存在，將 sConfigName 設定為現有的組態名稱
     
256. sConfigName = Configs(i)
     
257. Exit For
     
258. End If
     
259. Next
     
260. End If
     
261. 
     
262. Dim retval As Long
     
263. '刪除"SAP料號"欄
     
264. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "SAP料號")
     
265. '新增"SAP料號"欄
     
266. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "SAP料號", swCustomInfoText, sapNumber)
     
267. 
     
268. '刪除"加工方法"欄
     
269. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "加工方法")
     
270. '新增"加工方法"欄
     
271. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "加工方法", swCustomInfoText, fCode)
     
272. 
     
273. '刪除"階層"欄
     
274. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "階層")
     
275. '新增"階層"欄
     
276. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "階層", swCustomInfoText, gCode)
     
277. 
     
278. 
     
279. '寫入作者
     
280. Set swApp = Application.SldWorks
     
281. Set Part = swApp.ActiveDoc
     
282. Part.SummaryInfo(swSumInfoAuthor) = "XXX"
     
283. 
     
284. 
     
285. '刪除全部屬性
     
286. Set swApp = Application.SldWorks
     
287. Set Part = swApp.ActiveDoc
     
288. p = "" '指定模型組態名稱 ，如果要刪自訂則空白
     
289. k = Part.GetCustomInfoNames2(p)
     
290. For i = 0 To UBound(k)
     
291. Part.DeleteCustomInfo2 p, k(i)
     
292. Next
     
293. 
     
294. 
     
295. '-------------------------------------------------------------------------
     
296. '樹狀結構顯示
     
297. Set swApp = _
     
298. Application.SldWorks
     
299. Set Part = swApp.ActiveDoc
     
300. Set intance = Part.FeatureManager
     
301. 
     
302. '顯示特徵名稱
     
303. intance.ShowFeatureName = True
     
304. '顯示特徵描述
     
305. intance.ShowFeatureDescription = False
     
306. 
     
307. '顯示零組件名稱
     
308. intance.ShowComponentNames = True
     
309. '顯示零組件描述
     
310. intance.ShowComponentDescriptions = True
     
311. '顯示零組件模型組態名稱
     
312. intance.ShowComponentConfigurationNames = True
     
313. '顯示零組件模型組態描述
     
314. intance.ShowComponentConfigurationDescriptions = False
     
315. '顯示顯示狀態名稱
     
316. intance.ShowDisplayStateNames = False
     
317. 
     
318. '顯示特徵
     
319. intance.ViewFeatures = True
     
320. 
     
321. '------------------------------------------------------------------------------
     
322. 
     
323. '重新整理
     
324. Set Part = swApp.ActiveDoc
     
325. boolstatus = Part.EditRebuild3()
     
326. 
     
327. 
     
328. ' 顯示成功訊息
     
329. 'MsgBox "█ SAP 料號已寫入 █"
     
330. '------------------------------------------------------------------------------
     
331. End If
     
332. '*********************************************************
     
333. 
     
334. End Sub

複製代碼

ㄚ水

Francis 發表於 2024/4/3 09:08

感謝悶大的回覆

根據您提供的程式碼我跑了一下跳出如上圖的的錯誤
我不知道是什麼原因...因為小弟個人是還沒有能力可以修改或理解程式碼
我只有辦法盡量從正確的程式碼去回推它的功能後再一行一行的加上備註慢慢了解
或者是從GPT去寫,但GPT常常寫出來的也不是我要的或不成功
所以如果是新的功能或應用我就不太知道怎麼增加或修改...

Francis

說實話，水哥提供的2個巨集，悶人未曾執行過，也不知道有什麼用途，只是照搬合拼而已，肯定存在諸多問題的，請不要見怪。

出現錯誤的語句 Dim，全名是 Declare In Memory，不是尺寸 Dimension。
是宣告一個變量在記憶體中所需的位元量，詳見：https://learn.microsoft.com/en-u ... p/data-type-summary

由於在同一段的程式碼中，同一個變量只可作一次的宣告，若需要重新宣告，就要用到 Redim 語句。

解決辦法：
。
。
。
。
。
。
。
。
。
。
。
。
。
。
。
。
。。
。
。
。
。
。
。
。
。
。
。
。
。
。
。。
。
。
。
。
。
。
。
。
。
。
。
。
。
。。
。
。
。
。
。
。
。
。
。
。
。
。
。
。


只要把重複的宣告刪除即可解決。

ㄚ水

Francis 發表於 2024/4/9 00:21
說實話，水哥提供的2個巨集，悶人未曾執行過，也不知道有什麼用途，只是照搬合拼而已，肯定存在諸多問題的 ...

感謝悶大回覆

我再研究看看  但這大概不會是我三兩個天甚至月可以無師自通學會的
真不行的話就只能做成兩個巨集分開使用了...

感謝~

ㄚ水

Francis 發表於 2024/4/9 00:21
說實話，水哥提供的2個巨集，悶人未曾執行過，也不知道有什麼用途，只是照搬合拼而已，肯定存在諸多問題的 ...

花了點時間總算整合起來了

原來是要弄個主程序去判斷該對應哪個子程序

1. Sub JET_零件圖名轉料號_機構_檔案類型判別()
   
2. 
   
3.     Dim swApp As SldWorks.SldWorks
   
4.     Dim swModel As SldWorks.ModelDoc2
   
5. 
   
6.     Set swApp = Application.SldWorks
   
7.     Set swModel = swApp.ActiveDoc
   
8. 
   
9.     If swModel Is Nothing Then
   
10.         MsgBox "請開啟 SolidWorks 檔案。"
    
11.         Exit Sub
    
12.     End If
    
13.    
    
14. 
    
15. ' 如果為零件檔案則使用JET_零件圖名轉料號_機構_零件的子程式
    
16.     If swModel.GetType = swDocPART Then
    
17.         JET_零件圖名轉料號_機構_零件
    
18. 
    
19. ' 如果為組件檔案則使用JET_零件圖名轉料號_機構_組件的子程式
    
20.     ElseIf swModel.GetType = swDocASSEMBLY Then
    
21.         JET_零件圖名轉料號_機構_組件
    
22. 
    
23. 
    
24. 
    
25.     Else
    
26.         ' 其他類型的檔案
    
27.         MsgBox "此檔案類型不支持此操作。"
    
28.     End If
    
29. 
    
30. '以上為將兩個子程序整合成一個主程序，然後添加一個判斷文件類型的條件，以確定要執行哪個子程序。
    
31. End Sub

複製代碼