思路是将SW的BOM表导入到EXCEL，然后将EXCEL的数据（零件名+数量）写入到字典，然后通过文件名来匹配到字典里存的数据（数量）写入到零件的数量属性。其中提示请输入数据时需要粘帖数据进来。Myr = 500 '需人工设定。欢迎大家进行补充、使程序更智能。
+ ]" E( _6 X, W u
8 c5 a' L& a5 E; BSub main()
: l( j, M, |4 E6 h7 {'打开EXCEL表格开始
6 N& I$ Y: T. \5 I8 {4 aDim ExcelSheet As Object
! K% p u3 J' b7 J, gSet ExcelSheet = CreateObject("Excel.Sheet")
4 }+ m. T+ F8 ]& z( p" a+ iExcelSheet.Application.Visible = True9 C$ l- e. B# d1 O, T" ~$ K5 F
'结束
' r' I/ I4 m8 t9 P
$ F2 R3 k3 R- D8 k'填入数据开始
; B: K9 p& u2 eDim d, @3 Q- v# N& f5 F4 C
Set d = CreateObject("Scripting.Dictionary")
4 B5 w* g" G: r/ ? O4 HMsgBox "请输入数据"; R- O. \" ]- w" [
'结束7 }7 a4 h2 P! h7 @' o4 v8 y
2 ?# f$ Z" U/ c'数据写入字典开始/ P. O& A2 |2 d; d1 f
Dim Myr&: W w7 s v) g! E& J. ^9 Z5 I7 ]
Myr = 500 '需人工设定
' ^( E V* T! |9 O7 g6 R( bFor i = 1 To Myr! N* \; p6 Z2 L" @/ r) F0 m4 K. S
d(ExcelSheet.Application.Cells(i, 1).Value) = ExcelSheet.Application.Cells(i, 2).Value. V/ U5 s2 M4 s5 ^9 h) c# Y, C
Next8 w8 D' [8 R! I- t
'结束
) B- B1 M* v* }0 M0 r, j- \/ \4 v: a! `9 S7 _+ M
'将字典数据逐个写入到零件开始3 v& U. ~4 `+ q, d
Dim swApp As Object N; b; ^9 R* W7 I d
Dim Part As Object
" X* [, X& m( K! e- R; f# ~0 R4 \Dim longstatus As Long, longwarnings As Long5 V# b% o& i9 z1 x" l% R
Dim myPath$, myFile$2 m& P' ~5 U& j6 |6 a
* q- w5 z# h' U9 O* f" Q
Set swApp = _
$ A+ y0 F) Z8 m. x; j* yApplication.SldWorks
$ I- |" ?, M- U- b" S5 q4 cmyPath = "C:\Users\Administrator\Desktop\1\" '..........................重点：把文件路径定义给变量
7 s& ~* |" G5 p$ n5 X/ B$ Y8 r% hmyFile = Dir(myPath & "*.sldprt") '依次找寻指定路径中的*.文件
+ K7 l' D3 n( n* {; HDo While myFile <> ""2 e7 `& {% p! F6 O$ y# b
Set Part = swApp.OpenDoc6(myPath & myFile, 1, 0, "", longstatus, longwarnings) a% o" u& r# S3 a0 r2 W
& ^8 ]0 X- [) x, n# m) p+ M
'单个零件写入数据开始8 Z, t, Q0 L/ r/ a: c5 |
'Dim swApp As Object9 A6 u* r* c3 B, ~2 K a' y K
Dim c As String' ]4 | h C4 d* C* q% l) F$ {
Set swApp = Application.SldWorks
8 P9 X2 [- o7 ^0 O# }0 L: ?Set Part = swApp.ActiveDoc, ^, }& E3 s' S7 f
c = swApp.ActiveDoc.GetTitle() '零件名
5 f$ t$ X3 x9 d3 v. S" N; ?blnretval = Part.AddCustomInfo3("", "数量", swCustomInfoText, d.Item(c))9 ?* z, [6 z5 _
'单个零件写入数据结束
3 b) w' _, P" I5 ~0 V( j% w% x) U: w* k9 o6 \: n3 G
Part.Save) u5 w9 \( s2 @
swApp.CloseDoc myPath & myFile& _+ h( d/ o/ A% q- ~. W
myFile = Dir '找寻下一个*.文件
Y* B9 \" @: @, h3 H4 `1 DLoop9 q( _! f$ S8 i4 {: y q
'将字典数据逐个写入到零件结束
5 r& P; U: r7 o+ i& rEnd Sub( A7 v6 P( o. H/ y8 c
|
发表于 2019-3-2 12:47:00
