将BOM表中零件的数量写入到零件图的属性中的VBA程序

慕容揽月

思路是将SW的BOM表导入到EXCEL，然后将EXCEL的数据（零件名+数量）写入到字典，然后通过文件名来匹配到字典里存的数据（数量）写入到零件的数量属性。其中提示请输入数据时需要粘帖数据进来。Myr = 500 '需人工设定。欢迎大家进行补充、使程序更智能。

Sub main()
'打开EXCEL表格开始
* b! }1 v* Y! L; `Dim ExcelSheet As Object
Set ExcelSheet = CreateObject("Excel.Sheet")
$ n: f" W* j( ?* y& `8 }ExcelSheet.Application.Visible = True
'结束
& B! c! e8 Z* n! j! K
6 c* D, ^; R" q% P- R7 h'填入数据开始
Dim d
Set d = CreateObject("Scripting.Dictionary")
# ?+ T& u8 e2 d( aMsgBox "请输入数据"
  `6 T2 m6 M& [/ |9 D# H$ ]'结束

'数据写入字典开始
Dim Myr&
Myr = 500 '需人工设定
For i = 1 To Myr
d(ExcelSheet.Application.Cells(i, 1).Value) = ExcelSheet.Application.Cells(i, 2).Value
% o" @8 ~1 H3 ~# |Next
; e: ]1 m" u$ g0 r" O7 E'结束
; H( K  N  y/ t
: \  B% w6 H0 n0 i  Q" Z% R/ K) b'将字典数据逐个写入到零件开始
Dim swApp As Object
Dim Part As Object
Dim longstatus As Long, longwarnings As Long
' P- u- M/ ?5 G% hDim myPath$, myFile$

Set swApp = _
: l( Y1 k- w9 A% k3 K3 S" I" zApplication.SldWorks
myPath = "C:\Users\Administrator\Desktop\1\" '..........................重点：把文件路径定义给变量
1 C8 w" }9 w  X% jmyFile = Dir(myPath & "*.sldprt") '依次找寻指定路径中的*.文件
Do While myFile <> ""
Set Part = swApp.OpenDoc6(myPath & myFile, 1, 0, "", longstatus, longwarnings)
4 [) Q4 D& ~# `% W6 ]9 F$ V6 L9 ^; C
) O" w0 K7 g. p& o+ p    '单个零件写入数据开始
'Dim swApp As Object
' t" W: R6 f6 E- X: gDim c As String
: y& v9 v& _  W; k( ?Set swApp = Application.SldWorks
6 B& Q/ W- g+ WSet Part = swApp.ActiveDoc
c = swApp.ActiveDoc.GetTitle() '零件名
* w9 [, s: u- X. A0 ^blnretval = Part.AddCustomInfo3("", "数量", swCustomInfoText, d.Item(c))
    '单个零件写入数据结束
! g( [2 d9 @* _+ g$ X1 L. h
Part.Save
swApp.CloseDoc myPath & myFile
myFile = Dir '找寻下一个*.文件
5 G' k! g  z% z, t1 ~$ {  ~Loop
'将字典数据逐个写入到零件结束
& W7 M2 U) P& w  p# c" k. i( k6 jEnd Sub
3 _) n/ X9 _" j

hdgd501

谢谢楼主分享，期待高手进来进一步完善

Miles_chen

楼主这个，数量写入 需要是都改为一个数量吧 不然容易出错
3 x% q( W9 q7 W( T我之前选择的方式是：excel 内输入bom表，零件名称 及 需要写入的属性
然后通过excel 调用SW，逐个打开part，写入cell内的数量 或者 其他属性，再关闭

Miles_chen

哦 刚开始没看清
8 `  L; R) s' f你是全部写到 数组里，然后做对比……，以装配体树结构为准
我是直接按excel 零件名，顺序调用打开文件 ，以excel为准