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

慕容揽月

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

Sub main()
'打开EXCEL表格开始
Dim ExcelSheet As Object
Set ExcelSheet = CreateObject("Excel.Sheet")
' u4 b) ]+ H* ^3 k* QExcelSheet.Application.Visible = True
'结束

'填入数据开始
; p( P" I# m' WDim d
) {+ @: g0 F" tSet d = CreateObject("Scripting.Dictionary")
* i) z: f) N' @* lMsgBox "请输入数据"
( [" a- ?- _; F' {& N) q  J'结束

'数据写入字典开始
Dim Myr&
Myr = 500 '需人工设定
For i = 1 To Myr
- y  T. [9 v' md(ExcelSheet.Application.Cells(i, 1).Value) = ExcelSheet.Application.Cells(i, 2).Value
" M5 `& n4 D4 R( r' eNext
6 h& z, y- @$ q7 m7 p: C'结束

2 I1 p& D4 x3 R( ?" ['将字典数据逐个写入到零件开始
- h. l6 e) W7 x' C( N4 j$ jDim swApp As Object
# K) i" b0 l" u+ s2 W6 E7 oDim Part As Object
Dim longstatus As Long, longwarnings As Long
Dim myPath$, myFile$

Set swApp = _
Application.SldWorks
2 }7 w' R6 ]# z/ c- A4 G0 ]4 A7 ymyPath = "C:\Users\Administrator\Desktop\1\" '..........................重点：把文件路径定义给变量
% Y! P3 w* n" \4 W) a/ @* g8 `: TmyFile = Dir(myPath & "*.sldprt") '依次找寻指定路径中的*.文件
5 E- g. ?  M7 y4 ]# sDo While myFile <> ""
Set Part = swApp.OpenDoc6(myPath & myFile, 1, 0, "", longstatus, longwarnings)
! \' E9 \+ P  y  x8 R2 {
( O% g$ m! I  t+ g9 f7 H* u; T* V    '单个零件写入数据开始
. {( F4 o$ l0 P  n% a8 Q'Dim swApp As Object
0 r8 M! |4 ~+ F! q3 x" eDim c As String
Set swApp = Application.SldWorks
: b. H: G6 w: ZSet Part = swApp.ActiveDoc
c = swApp.ActiveDoc.GetTitle() '零件名
blnretval = Part.AddCustomInfo3("", "数量", swCustomInfoText, d.Item(c))
    '单个零件写入数据结束
6 ]3 F+ A( l/ e/ N; G" e
Part.Save
swApp.CloseDoc myPath & myFile
9 P6 C- M2 ^/ ~- J! {myFile = Dir '找寻下一个*.文件
& a: A0 L$ r1 ?2 TLoop
'将字典数据逐个写入到零件结束
End Sub

hdgd501

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

Miles_chen

楼主这个，数量写入 需要是都改为一个数量吧 不然容易出错
3 Y1 Q2 o4 Y9 v0 u我之前选择的方式是：excel 内输入bom表，零件名称 及 需要写入的属性
( O+ i; p9 m8 x7 U8 x然后通过excel 调用SW，逐个打开part，写入cell内的数量 或者 其他属性，再关闭

Miles_chen

哦 刚开始没看清
" P% v) Q/ d- a5 [你是全部写到 数组里，然后做对比……，以装配体树结构为准
我是直接按excel 零件名，顺序调用打开文件 ，以excel为准