將BOM表中零件的數量寫入到零件圖的屬性中的VBA程序

慕容攬月

思路是將SW的BOM表導入到EXCEL，然后將EXCEL的數據（零件名+數量）寫入到字典，然后通過文件名來匹配到字典里存的數據（數量）寫入到零件的數量屬性。其中提示請輸入數據時需要粘帖數據進來。Myr = 500 '需人工設定。歡迎大家進行補充、使程序更智能。
2 k* z. A7 t0 Z( o* U+ s6 p; h# ^, d- ^/ k
Sub main()
) ~" u9 V  e3 ?* o6 [+ M$ s  _'打開EXCEL表格開始
3 b' t. x8 P# @* U' C# dDim ExcelSheet As Object
Set ExcelSheet = CreateObject("Excel.Sheet")
ExcelSheet.Application.Visible = True
'結束

'填入數據開始
, H0 X6 H5 G7 i) h# TDim d
Set d = CreateObject("Scripting.Dictionary")
& J0 k# ^3 ]9 r' g; W( F) |6 Y! uMsgBox "請輸入數據"
'結束
0 I5 l1 L. b) U) M- w2 \
' u6 d; E5 R8 \. H" a1 K'數據寫入字典開始
Dim Myr&
; V4 t* Y; N9 b" M. ~# gMyr = 500 '需人工設定
For i = 1 To Myr
; I5 {4 _# G; {  qd(ExcelSheet.Application.Cells(i, 1).Value) = ExcelSheet.Application.Cells(i, 2).Value
Next
, \# C  Q9 e9 U3 ]( y# g( K* t'結束
. p& E: @6 S2 Q0 i( ]
( G- l+ M7 J8 L6 }'將字典數據逐個寫入到零件開始
Dim swApp As Object
Dim Part As Object
Dim longstatus As Long, longwarnings As Long
6 E& G# m5 s! O4 j2 h5 X* Y7 rDim myPath$, myFile$

0 {! k6 i' c+ i" Z3 lSet swApp = _
Application.SldWorks
- T  h) a  y) i. \9 q9 F% rmyPath = "C:\Users\Administrator\Desktop\1\" '..........................重點：把文件路徑定義給變量
$ B1 X# S' _9 l5 [4 v% I: v9 p/ t- `myFile = Dir(myPath & "*.sldprt") '依次找尋指定路徑中的*.文件
2 _: f# h$ M. f9 W( `  ZDo While myFile <> ""
Set Part = swApp.OpenDoc6(myPath & myFile, 1, 0, "", longstatus, longwarnings)

    '單個零件寫入數據開始
2 e# F/ x: Y1 W'Dim swApp As Object
Dim c As String
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
3 Y% q) B$ r) r% ^6 _c = swApp.ActiveDoc.GetTitle() '零件名
2 U+ @0 I. o( L% L) Sblnretval = Part.AddCustomInfo3("", "數量", swCustomInfoText, d.Item(c))
+ F9 Z5 n6 {' a0 o- V( j( f    '單個零件寫入數據結束

Part.Save
6 Z' S# {) w, q* G% M, sswApp.CloseDoc myPath & myFile
' m* F" ^7 [2 V, L5 b" ~3 PmyFile = Dir '找尋下一個*.文件
3 L7 ~9 a1 B2 G& t- b$ wLoop
) k  w1 `+ o9 g7 `1 u'將字典數據逐個寫入到零件結束
/ R, W* G4 e/ U. E. t2 bEnd Sub

hdgd501

謝謝樓主分享，期待高手進來進一步完善

Miles_chen

樓主這個，數量寫入 需要是都改為一個數量吧 不然容易出錯
我之前選擇的方式是：excel 內輸入bom表，零件名稱 及 需要寫入的屬性
然后通過excel 調用SW，逐個打開part，寫入cell內的數量 或者 其他屬性，再關閉

Miles_chen

哦 剛開始沒看清
  ]8 b7 G# ^1 E  A( u1 k你是全部寫到 數組里，然后做對比……，以裝配體樹結構為準
# r: x' A5 I% ~% p" o  r我是直接按excel 零件名，順序調用打開文件 ，以excel為準