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

慕容揽月

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

Sub main()
  p2 r( m9 S% H) R& L! V0 ?'打开EXCEL表格开始
Dim ExcelSheet As Object
Set ExcelSheet = CreateObject("Excel.Sheet")
ExcelSheet.Application.Visible = True
'结束

'填入数据开始
# Z( Q8 n$ Y8 C( m/ e' [Dim d
Set d = CreateObject("Scripting.Dictionary")
MsgBox "请输入数据"
'结束
3 @, t3 t2 G$ Z7 ]+ ~8 L( P* q6 r
'数据写入字典开始
( h- T' Z) {' Z" X' ~: h) aDim Myr&
Myr = 500 '需人工设定
8 I3 j  p1 G1 \5 |/ O! A, JFor i = 1 To Myr
  s6 _1 s) p& S) wd(ExcelSheet.Application.Cells(i, 1).Value) = ExcelSheet.Application.Cells(i, 2).Value
Next
'结束

'将字典数据逐个写入到零件开始
% e2 W4 Z. G  m4 s3 X/ ~0 s1 _Dim swApp As Object
Dim Part As Object
+ H" W! b! K. U( `Dim longstatus As Long, longwarnings As Long
& e: F; G- j; D1 w  w  TDim myPath$, myFile$
9 R. K# N5 h! l9 s+ b
Set swApp = _
Application.SldWorks
myPath = "C:\Users\Administrator\Desktop\1\" '..........................重点：把文件路径定义给变量
myFile = Dir(myPath & "*.sldprt") '依次找寻指定路径中的*.文件
Do While myFile <> ""
Set Part = swApp.OpenDoc6(myPath & myFile, 1, 0, "", longstatus, longwarnings)
; ^+ |" f# v2 V, Y, R- O& M$ W9 Q
  b- R: h$ j: Y9 X# [4 @" l    '单个零件写入数据开始
'Dim swApp As Object
, s# k: ~7 p1 x2 x) W) [Dim c As String
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
c = swApp.ActiveDoc.GetTitle() '零件名
( Q8 h" }: Q% n+ eblnretval = Part.AddCustomInfo3("", "数量", swCustomInfoText, d.Item(c))
1 K. \5 a3 M; S( e! |    '单个零件写入数据结束

Part.Save
swApp.CloseDoc myPath & myFile
# }4 E0 T$ S' q# GmyFile = Dir '找寻下一个*.文件
& p( h; [5 i4 f' z2 qLoop
'将字典数据逐个写入到零件结束
6 g' L7 g; Y& R. [End Sub
: k5 v6 `+ l+ ?$ G

hdgd501

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

Miles_chen

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

Miles_chen

哦 刚开始没看清
你是全部写到 数组里，然后做对比……，以装配体树结构为准
! J' b' e0 Q$ t7 m0 E我是直接按excel 零件名，顺序调用打开文件 ，以excel为准