SolidWorks專門論壇 SolidWorks forum

 找回密碼
 註冊
查看: 201|回復: 4

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

[複製鏈接]
發表於 2024/4/2 10:30:31 | 顯示全部樓層 |閱讀模式

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

如下 : 一組是零件檔的轉碼 一組是組件檔的轉碼
想說是否能整合成一個巨集就可以自行判斷檔案類型後自動使用對用的程式碼
  1. Sub JET_零件圖名轉料號_機構_組件()

  2. Dim swApp As SldWorks.SldWorks
  3. Dim swModel As SldWorks.ModelDoc2
  4. Dim aCode As String '機種代碼
  5. Dim bCode As String '模組代碼
  6. Dim sapNumber As String '料號總成
  7. Set swApp = Application.SldWorks '初始化SOLIDWORKS應用程式

  8. '-------------------------------檢查檔案格式---------------------------------

  9. Set swModel = swApp.ActiveDoc '設置模型為激活的文件
  10. ' 檢查當前文件檔案格式是否正確
  11. 'If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then '此為工程圖檔
  12. 'If (swModel Is Nothing) Or (swModel.GetType <> swDocPART) Then '此為零件檔
  13. If (swModel Is Nothing) Or (swModel.GetType <> swDocASSEMBLY) Then '此為組合件檔

  14. '向用戶發送錯誤訊息
  15. swApp.SendMsgToUser ("【 僅 適 用 於 組 件 檔 】")


  16. ' 如果沒有加載模型,則退出
  17. Exit Sub

  18. End If

  19. '---------------------------------------------------------------------------

  20. Set swApp = Application.SldWorks
  21. Set swModel = swApp.ActiveDoc

  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. 'Get the aCode(機種代碼截取)
  29. aCode = Left(fileName, InStr(fileName, "#") - 3)
  30. ' aCode(機種代碼轉換)
  31. Select Case aCode

  32. Case "共用型選項": aCode = "1100"
  33. Case "5500V": aCode = "1101"
  34. Case "5500MLR": aCode = "1102"
  35. Case "5500MLB": aCode = "1103"
  36. Case "5500SLR": aCode = "1104"
  37. Case "5500SLB": aCode = "1105"
  38. Case "5500SLGR": aCode = "1106"

  39. Case Else: aCode = "****"
  40. End Select

  41. 'Get the bCode(模組碼截取)
  42. bCode = Mid(fileName, InStr(fileName, "#") - 2, 2)

  43. 'Generate the SAP number(料號組合)
  44. sapNumber = aCode & bCode & "**"


  45. ' 建立自訂屬性值
  46. Dim sConfigName As String
  47. sConfigName = "預設" ' *****設定要寫入的組態名稱*****
  48. Dim Configs As Variant
  49. Configs = swApp.ActiveDoc.GetConfigurationNames()

  50. ' 檢查是否有現有的組態名稱
  51. If IsArray(Configs) Then
  52. For i = 0 To UBound(Configs)
  53. If Configs(i) = sConfigName Then
  54. ' 如果已存在,將 sConfigName 設定為現有的組態名稱
  55. sConfigName = Configs(i)
  56. Exit For
  57. End If
  58. Next
  59. End If

  60. Dim retval As Long
  61. '刪除"SAP料號"欄
  62. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "SAP料號")
  63. '新增"SAP料號"欄
  64. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "SAP料號", swCustomInfoText, sapNumber)

  65. '刪除"加工方法"欄
  66. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "加工方法")
  67. '新增"加工方法"欄
  68. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "加工方法", swCustomInfoText, fCode)

  69. '刪除"階層"欄
  70. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "階層")
  71. '新增"階層"欄
  72. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "階層", swCustomInfoText, gCode)


  73. '寫入作者
  74. Set swApp = Application.SldWorks
  75. Set Part = swApp.ActiveDoc
  76. Part.SummaryInfo(swSumInfoAuthor) = "XXX"


  77. '刪除全部屬性
  78. Set swApp = Application.SldWorks
  79. Set Part = swApp.ActiveDoc
  80. p = "" '指定模型組態名稱 ,如果要刪自訂則空白
  81. k = Part.GetCustomInfoNames2(p)
  82. For i = 0 To UBound(k)
  83. Part.DeleteCustomInfo2 p, k(i)
  84. Next


  85. '-------------------------------------------------------------------------
  86. '樹狀結構顯示
  87. Set swApp = _
  88. Application.SldWorks
  89. Set Part = swApp.ActiveDoc
  90. Set intance = Part.FeatureManager

  91. '顯示特徵名稱
  92. intance.ShowFeatureName = True
  93. '顯示特徵描述
  94. intance.ShowFeatureDescription = False

  95. '顯示零組件名稱
  96. intance.ShowComponentNames = True
  97. '顯示零組件描述
  98. intance.ShowComponentDescriptions = True
  99. '顯示零組件模型組態名稱
  100. intance.ShowComponentConfigurationNames = True
  101. '顯示零組件模型組態描述
  102. intance.ShowComponentConfigurationDescriptions = False
  103. '顯示顯示狀態名稱
  104. intance.ShowDisplayStateNames = False

  105. '顯示特徵
  106. intance.ViewFeatures = True

  107. '------------------------------------------------------------------------------

  108. '重新整理
  109. Set Part = swApp.ActiveDoc
  110. boolstatus = Part.EditRebuild3()


  111. ' 顯示成功訊息
  112. 'MsgBox "█ SAP 料號已寫入 █"


  113. End Sub
複製代碼
  1. Sub JET_零件圖名轉料號_機構_零件()

  2. Dim swApp As SldWorks.SldWorks
  3. Dim swModel As SldWorks.ModelDoc2
  4. Dim aCode As String '機種代碼
  5. Dim bCode As String '加工代碼
  6. Dim cCode As String '版次代碼
  7. Dim dCode As String '模組代碼
  8. Dim eCode As String '流水碼
  9. Dim fCode As String '加工碼
  10. Dim gCode As String '階層碼
  11. Dim sapNumber As String '料號總成
  12. Set swApp = Application.SldWorks '初始化SOLIDWORKS應用程式

  13. '-------------------------------檢查檔案格式---------------------------------

  14. Set swModel = swApp.ActiveDoc '設置模型為激活的文件
  15. ' 檢查當前文件檔案格式是否正確
  16. 'If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then '此為工程圖檔
  17. If (swModel Is Nothing) Or (swModel.GetType <> swDocPART) Then '此為零件檔
  18. 'If (swModel Is Nothing) Or (swModel.GetType <> swDocASSEMBLY) Then '此為組合件檔

  19. '向用戶發送錯誤訊息
  20. swApp.SendMsgToUser ("【 僅 適 用 於 零 件 檔 】")


  21. ' 如果沒有加載模型,則退出
  22. Exit Sub

  23. End If

  24. '---------------------------------------------------------------------------

  25. Set swApp = Application.SldWorks
  26. Set swModel = swApp.ActiveDoc

  27. 'Get the current file name
  28. Dim fileName As String
  29. ' 取得當前開啟的檔案名稱(含路徑)
  30. fileName = swModel.GetPathName()
  31. ' 取得檔案名稱(含副檔名)
  32. fileName = Right(fileName, Len(fileName) - InStrRev(fileName, ""))

  33. 'Get the aCode(機種代碼截取)
  34. aCode = Left(fileName, InStr(fileName, "-") - 3)
  35. ' aCode(機種代碼轉換)
  36. Select Case aCode

  37. Case "共用型選項": aCode = "1100"
  38. Case "5500V": aCode = "1101"
  39. Case "5500MLR": aCode = "1102"
  40. Case "5500MLB": aCode = "1103"
  41. Case "5500SLR": aCode = "1104"
  42. Case "5500SLB": aCode = "1105"
  43. Case "5500SLGR": aCode = "1106"
  44. Case "7700S": aCode = "6666"
  45. Case "3000SLR": aCode = "1104"

  46. Case Else: aCode = "****"
  47. End Select

  48. 'Get the bCode(加工碼截取)
  49. bCode = Mid(fileName, InStr(fileName, "-") + 1, 1)
  50. ' bCode(加工碼轉換)
  51. Select Case bCode
  52. Case "D": bCode = "3001"
  53. Case "C": bCode = "3002"
  54. Case "M": bCode = "3003"
  55. Case "L": bCode = "3004"
  56. Case "P": bCode = "3005"
  57. Case "A": bCode = "3006"
  58. Case "S": bCode = "3007"
  59. Case "U": bCode = "3008"
  60. Case "B": bCode = "3009"
  61. Case "R": bCode = "3010"
  62. Case "Y": bCode = "3011"
  63. Case "F": bCode = "3012"
  64. Case "Z": bCode = "3013"
  65. Case "G": bCode = "3015"
  66. Case "H": bCode = "3016"
  67. Case "J": bCode = "3017"
  68. Case Else: bCode = "****"
  69. End Select

  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. 'Get the dCode(模組碼截取)
  103. dCode = Mid(fileName, InStr(fileName, "-") - 2, 2)

  104. 'Get the eCode(流水碼截取)
  105. eCode = Mid(fileName, InStr(fileName, "-") + 3, 3)

  106. 'Get the fCode(加工碼截取)
  107. fCode = Mid(fileName, InStr(fileName, "-") + 1, 1)

  108. 'Get the gCode(階層碼截取)
  109. gCode = Mid(fileName, InStr(fileName, "-") + 1, 1)
  110. ' gCode(階層碼轉換)
  111. Select Case gCode
  112. Case "P": gCode = "4"
  113. Case Else: gCode = "3"
  114. End Select


  115. 'Generate the SAP number(料號組合)
  116. sapNumber = bCode & aCode & dCode & eCode & cCode


  117. ' 建立自訂屬性值
  118. Dim sConfigName As String
  119. sConfigName = "預設" ' *****設定要寫入的組態名稱*****
  120. Dim Configs As Variant
  121. Configs = swApp.ActiveDoc.GetConfigurationNames()

  122. ' 檢查是否有現有的組態名稱
  123. If IsArray(Configs) Then
  124. For i = 0 To UBound(Configs)
  125. If Configs(i) = sConfigName Then
  126. ' 如果已存在,將 sConfigName 設定為現有的組態名稱
  127. sConfigName = Configs(i)
  128. Exit For
  129. End If
  130. Next
  131. End If

  132. Dim retval As Long
  133. '刪除"SAP料號"欄
  134. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "SAP料號")
  135. '新增"SAP料號"欄
  136. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "SAP料號", swCustomInfoText, sapNumber)

  137. '刪除"加工方法"欄
  138. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "加工方法")
  139. '新增"加工方法"欄
  140. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "加工方法", swCustomInfoText, fCode)

  141. '刪除"階層"欄
  142. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "階層")
  143. '新增"階層"欄
  144. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "階層", swCustomInfoText, gCode)


  145. '寫入作者
  146. Set swApp = Application.SldWorks
  147. Set Part = swApp.ActiveDoc
  148. Part.SummaryInfo(swSumInfoAuthor) = "XXX"


  149. '刪除全部屬性
  150. Set swApp = Application.SldWorks
  151. Set Part = swApp.ActiveDoc
  152. p = "" '指定模型組態名稱 ,如果要刪自訂則空白
  153. k = Part.GetCustomInfoNames2(p)
  154. For i = 0 To UBound(k)
  155. Part.DeleteCustomInfo2 p, k(i)
  156. Next


  157. '-------------------------------------------------------------------------
  158. '樹狀結構顯示
  159. Set swApp = _
  160. Application.SldWorks
  161. Set Part = swApp.ActiveDoc
  162. Set intance = Part.FeatureManager

  163. '顯示特徵名稱
  164. intance.ShowFeatureName = True
  165. '顯示特徵描述
  166. intance.ShowFeatureDescription = False

  167. '顯示零組件名稱
  168. intance.ShowComponentNames = True
  169. '顯示零組件描述
  170. intance.ShowComponentDescriptions = True
  171. '顯示零組件模型組態名稱
  172. intance.ShowComponentConfigurationNames = True
  173. '顯示零組件模型組態描述
  174. intance.ShowComponentConfigurationDescriptions = False
  175. '顯示顯示狀態名稱
  176. intance.ShowDisplayStateNames = False

  177. '顯示特徵
  178. intance.ViewFeatures = True

  179. '------------------------------------------------------------------------------

  180. '重新整理
  181. Set Part = swApp.ActiveDoc
  182. boolstatus = Part.EditRebuild3()


  183. ' 顯示成功訊息
  184. 'MsgBox "█ SAP 料號已寫入 █"


  185. End Sub
複製代碼


發表於 2024/4/3 09:08:06 | 顯示全部樓層
  1. Sub JET_零件圖名轉料號_機構_零件及組件()

  2. Dim swApp As SldWorks.SldWorks
  3. Dim swModel As SldWorks.ModelDoc2
  4. Dim aCode As String '機種代碼
  5. Dim bCode As String '加工代碼
  6. Dim cCode As String '版次代碼
  7. Dim dCode As String '模組代碼
  8. Dim eCode As String '流水碼
  9. Dim fCode As String '加工碼
  10. Dim gCode As String '階層碼
  11. Dim sapNumber As String '料號總成
  12. Set swApp = Application.SldWorks '初始化SOLIDWORKS應用程式

  13. '-------------------------------檢查檔案格式---------------------------------

  14. Set swApp = Application.SldWorks
  15. Set swModel = swApp.ActiveDoc '設置模型為激活的文件
  16. '*********************************************************
  17. If swModel.GetType = swDocASSEMBLY Then '此為組合件檔

  18. 'Get the current file name
  19. Dim fileName As String
  20. ' 取得當前開啟的檔案名稱(含路徑)
  21. fileName = swModel.GetPathName()
  22. ' 取得檔案名稱(含副檔名)
  23. fileName = Right(fileName, Len(fileName) - InStrRev(fileName, ""))

  24. 'Get the aCode(機種代碼截取)
  25. aCode = Left(fileName, InStr(fileName, "-") - 3)
  26. ' aCode(機種代碼轉換)
  27. Select Case aCode

  28. Case "共用型選項": aCode = "1100"
  29. Case "5500V": aCode = "1101"
  30. Case "5500MLR": aCode = "1102"
  31. Case "5500MLB": aCode = "1103"
  32. Case "5500SLR": aCode = "1104"
  33. Case "5500SLB": aCode = "1105"
  34. Case "5500SLGR": aCode = "1106"
  35. Case "7700S": aCode = "6666"
  36. Case "3000SLR": aCode = "1104"

  37. Case Else: aCode = "****"
  38. End Select

  39. 'Get the bCode(加工碼截取)
  40. bCode = Mid(fileName, InStr(fileName, "-") + 1, 1)
  41. ' bCode(加工碼轉換)
  42. Select Case bCode
  43. Case "D": bCode = "3001"
  44. Case "C": bCode = "3002"
  45. Case "M": bCode = "3003"
  46. Case "L": bCode = "3004"
  47. Case "P": bCode = "3005"
  48. Case "A": bCode = "3006"
  49. Case "S": bCode = "3007"
  50. Case "U": bCode = "3008"
  51. Case "B": bCode = "3009"
  52. Case "R": bCode = "3010"
  53. Case "Y": bCode = "3011"
  54. Case "F": bCode = "3012"
  55. Case "Z": bCode = "3013"
  56. Case "G": bCode = "3015"
  57. Case "H": bCode = "3016"
  58. Case "J": bCode = "3017"
  59. Case Else: bCode = "****"
  60. End Select

  61. 'Get the cCode(版次代碼截取)
  62. cCode = Mid(fileName, InStr(fileName, "-") + 6, 1)
  63. ' cCode(版次代碼轉換)
  64. Select Case cCode
  65. Case "A": cCode = "01"
  66. Case "B": cCode = "02"
  67. Case "C": cCode = "03"
  68. Case "D": cCode = "04"
  69. Case "E": cCode = "05"
  70. Case "F": cCode = "06"
  71. Case "G": cCode = "07"
  72. Case "H": cCode = "08"
  73. Case "I": cCode = "09"
  74. Case "J": cCode = "10"
  75. Case "K": cCode = "11"
  76. Case "L": cCode = "12"
  77. Case "M": cCode = "13"
  78. Case "N": cCode = "14"
  79. Case "O": cCode = "15"
  80. Case "P": cCode = "16"
  81. Case "Q": cCode = "17"
  82. Case "R": cCode = "18"
  83. Case "S": cCode = "19"
  84. Case "T": cCode = "20"
  85. Case "U": cCode = "21"
  86. Case "V": cCode = "22"
  87. Case "W": cCode = "23"
  88. Case "X": cCode = "24"
  89. Case "Y": cCode = "25"
  90. Case "Z": cCode = "26"
  91. Case Else: cCode = "**"
  92. End Select

  93. 'Get the dCode(模組碼截取)
  94. dCode = Mid(fileName, InStr(fileName, "-") - 2, 2)

  95. 'Get the eCode(流水碼截取)
  96. eCode = Mid(fileName, InStr(fileName, "-") + 3, 3)

  97. 'Get the fCode(加工碼截取)
  98. fCode = Mid(fileName, InStr(fileName, "-") + 1, 1)

  99. 'Get the gCode(階層碼截取)
  100. gCode = Mid(fileName, InStr(fileName, "-") + 1, 1)
  101. ' gCode(階層碼轉換)
  102. Select Case gCode
  103. Case "P": gCode = "4"
  104. Case Else: gCode = "3"
  105. End Select


  106. 'Generate the SAP number(料號組合)
  107. sapNumber = bCode & aCode & dCode & eCode & cCode


  108. ' 建立自訂屬性值
  109. Dim sConfigName As String
  110. sConfigName = "預設" ' *****設定要寫入的組態名稱*****
  111. Dim Configs As Variant
  112. Configs = swApp.ActiveDoc.GetConfigurationNames()

  113. ' 檢查是否有現有的組態名稱
  114. If IsArray(Configs) Then
  115. For i = 0 To UBound(Configs)
  116. If Configs(i) = sConfigName Then
  117. ' 如果已存在,將 sConfigName 設定為現有的組態名稱
  118. sConfigName = Configs(i)
  119. Exit For
  120. End If
  121. Next
  122. End If

  123. Dim retval As Long
  124. '刪除"SAP料號"欄
  125. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "SAP料號")
  126. '新增"SAP料號"欄
  127. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "SAP料號", swCustomInfoText, sapNumber)

  128. '刪除"加工方法"欄
  129. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "加工方法")
  130. '新增"加工方法"欄
  131. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "加工方法", swCustomInfoText, fCode)

  132. '刪除"階層"欄
  133. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "階層")
  134. '新增"階層"欄
  135. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "階層", swCustomInfoText, gCode)


  136. '寫入作者
  137. Set swApp = Application.SldWorks
  138. Set Part = swApp.ActiveDoc
  139. Part.SummaryInfo(swSumInfoAuthor) = "XXX"


  140. '刪除全部屬性
  141. Set swApp = Application.SldWorks
  142. Set Part = swApp.ActiveDoc
  143. p = "" '指定模型組態名稱 ,如果要刪自訂則空白
  144. k = Part.GetCustomInfoNames2(p)
  145. For i = 0 To UBound(k)
  146. Part.DeleteCustomInfo2 p, k(i)
  147. Next


  148. '-------------------------------------------------------------------------
  149. '樹狀結構顯示
  150. Set swApp = _
  151. Application.SldWorks
  152. Set Part = swApp.ActiveDoc
  153. Set intance = Part.FeatureManager

  154. '顯示特徵名稱
  155. intance.ShowFeatureName = True
  156. '顯示特徵描述
  157. intance.ShowFeatureDescription = False

  158. '顯示零組件名稱
  159. intance.ShowComponentNames = True
  160. '顯示零組件描述
  161. intance.ShowComponentDescriptions = True
  162. '顯示零組件模型組態名稱
  163. intance.ShowComponentConfigurationNames = True
  164. '顯示零組件模型組態描述
  165. intance.ShowComponentConfigurationDescriptions = False
  166. '顯示顯示狀態名稱
  167. intance.ShowDisplayStateNames = False

  168. '顯示特徵
  169. intance.ViewFeatures = True

  170. '------------------------------------------------------------------------------

  171. '重新整理
  172. Set Part = swApp.ActiveDoc
  173. boolstatus = Part.EditRebuild3()


  174. ' 顯示成功訊息
  175. 'MsgBox "█ SAP 料號已寫入 █"

  176. End if
  177. '*********************************************************
  178. If swModel.GetType = swDocPART Then '此為零件檔

  179. 'Get the current file name
  180. Dim fileName As String
  181. ' 取得當前開啟的檔案名稱(含路徑)
  182. fileName = swModel.GetPathName()
  183. ' 取得檔案名稱(含副檔名)
  184. fileName = Right(fileName, Len(fileName) - InStrRev(fileName, ""))

  185. 'Get the aCode(機種代碼截取)
  186. aCode = Left(fileName, InStr(fileName, "#") - 3)
  187. ' aCode(機種代碼轉換)
  188. Select Case aCode

  189. Case "共用型選項": aCode = "1100"
  190. Case "5500V": aCode = "1101"
  191. Case "5500MLR": aCode = "1102"
  192. Case "5500MLB": aCode = "1103"
  193. Case "5500SLR": aCode = "1104"
  194. Case "5500SLB": aCode = "1105"
  195. Case "5500SLGR": aCode = "1106"

  196. Case Else: aCode = "****"
  197. End Select

  198. 'Get the bCode(模組碼截取)
  199. bCode = Mid(fileName, InStr(fileName, "#") - 2, 2)

  200. 'Generate the SAP number(料號組合)
  201. sapNumber = aCode & bCode & "**"


  202. ' 建立自訂屬性值
  203. Dim sConfigName As String
  204. sConfigName = "預設" ' *****設定要寫入的組態名稱*****
  205. Dim Configs As Variant
  206. Configs = swApp.ActiveDoc.GetConfigurationNames()

  207. ' 檢查是否有現有的組態名稱
  208. If IsArray(Configs) Then
  209. For i = 0 To UBound(Configs)
  210. If Configs(i) = sConfigName Then
  211. ' 如果已存在,將 sConfigName 設定為現有的組態名稱
  212. sConfigName = Configs(i)
  213. Exit For
  214. End If
  215. Next
  216. End If

  217. Dim retval As Long
  218. '刪除"SAP料號"欄
  219. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "SAP料號")
  220. '新增"SAP料號"欄
  221. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "SAP料號", swCustomInfoText, sapNumber)

  222. '刪除"加工方法"欄
  223. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "加工方法")
  224. '新增"加工方法"欄
  225. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "加工方法", swCustomInfoText, fCode)

  226. '刪除"階層"欄
  227. retval = swApp.ActiveDoc.DeleteCustomInfo2(sConfigName, "階層")
  228. '新增"階層"欄
  229. retval = swApp.ActiveDoc.AddCustomInfo3(sConfigName, "階層", swCustomInfoText, gCode)


  230. '寫入作者
  231. Set swApp = Application.SldWorks
  232. Set Part = swApp.ActiveDoc
  233. Part.SummaryInfo(swSumInfoAuthor) = "XXX"


  234. '刪除全部屬性
  235. Set swApp = Application.SldWorks
  236. Set Part = swApp.ActiveDoc
  237. p = "" '指定模型組態名稱 ,如果要刪自訂則空白
  238. k = Part.GetCustomInfoNames2(p)
  239. For i = 0 To UBound(k)
  240. Part.DeleteCustomInfo2 p, k(i)
  241. Next


  242. '-------------------------------------------------------------------------
  243. '樹狀結構顯示
  244. Set swApp = _
  245. Application.SldWorks
  246. Set Part = swApp.ActiveDoc
  247. Set intance = Part.FeatureManager

  248. '顯示特徵名稱
  249. intance.ShowFeatureName = True
  250. '顯示特徵描述
  251. intance.ShowFeatureDescription = False

  252. '顯示零組件名稱
  253. intance.ShowComponentNames = True
  254. '顯示零組件描述
  255. intance.ShowComponentDescriptions = True
  256. '顯示零組件模型組態名稱
  257. intance.ShowComponentConfigurationNames = True
  258. '顯示零組件模型組態描述
  259. intance.ShowComponentConfigurationDescriptions = False
  260. '顯示顯示狀態名稱
  261. intance.ShowDisplayStateNames = False

  262. '顯示特徵
  263. intance.ViewFeatures = True

  264. '------------------------------------------------------------------------------

  265. '重新整理
  266. Set Part = swApp.ActiveDoc
  267. boolstatus = Part.EditRebuild3()


  268. ' 顯示成功訊息
  269. 'MsgBox "█ SAP 料號已寫入 █"
  270. '------------------------------------------------------------------------------
  271. End If
  272. '*********************************************************

  273. End Sub
複製代碼

點評

[attachimg]256718[/attachimg] 感謝悶大的回覆 根據您提供的程式碼我跑了一下跳出如上圖的的錯誤 我不知道是什麼原因...因為小弟個人是還沒有能力可以修改或理解程式碼 我只有辦法盡量從正確的程式碼去回推它的功  詳情 回復 發表於 2024/4/8 09:52
 樓主| 發表於 2024/4/8 09:52:21 | 顯示全部樓層


感謝悶大的回覆

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

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
發表於 7 天前 | 顯示全部樓層
說實話,水哥提供的2個巨集,悶人未曾執行過,也不知道有什麼用途,只是照搬合拼而已,肯定存在諸多問題的,請不要見怪。

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

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

解決辦法:
















。。













。。













。。
















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

點評

感謝悶大回覆 我再研究看看 但這大概不會是我三兩個天甚至月可以無師自通學會的 真不行的話就只能做成兩個巨集分開使用了... 感謝~  詳情 回復 發表於 6 天前
 樓主| 發表於 6 天前 | 顯示全部樓層
Francis 發表於 2024/4/9 00:21
說實話,水哥提供的2個巨集,悶人未曾執行過,也不知道有什麼用途,只是照搬合拼而已,肯定存在諸多問題的 ...

感謝悶大回覆

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

感謝~
您需要登錄後才可以回帖 登錄 | 註冊

本版積分規則

論壇統計|手機版上論壇|論壇來自幾何科技 論壇架構版次 20240312

GMT+8, 2024/4/16 10:01 , Processed in 0.118784 second(s), 17 queries .

Powered by Discuz! X3.4 Licensed

© 2001-2023 Discuz! Team.

快速回復 返回頂部 返回列表