思路是将SW的BOM表导入到EXCEL,然后将EXCEL的数据(零件名+数量)写入到字典,然后通过文件名来匹配到字典里存的数据(数量)写入到零件的数量属性。其中提示请输入数据时需要粘帖数据进来。Myr = 500 '需人工设定。欢迎大家进行补充、使程序更智能。
) ~ I7 g2 A! {8 o! Y- E
: S- w# o' g; T5 c$ wSub main()
" e7 ]$ {8 n1 R: n'打开EXCEL表格开始: S) h8 f; o5 m# @
Dim ExcelSheet As Object: R: l9 v6 r+ J0 X. F8 w4 ^
Set ExcelSheet = CreateObject("Excel.Sheet")) f7 `( V8 A4 X) }9 m" `
ExcelSheet.Application.Visible = True
/ o- D5 x2 a3 L: Q, I. K6 ['结束
t8 q i5 C- H, Y$ E6 U+ i$ W1 S
'填入数据开始. M, p0 T+ L1 B( |
Dim d4 J* L2 T% s* h) c5 W3 E$ F
Set d = CreateObject("Scripting.Dictionary")0 l( {( Z; I0 m0 I+ J, x& g
MsgBox "请输入数据"
1 @5 `* C( r' u9 H+ A$ W'结束2 s% P% J8 q7 ]4 l8 x
% @( U. W! H) o'数据写入字典开始
3 Q; u+ E5 w/ ^6 @% ~Dim Myr&
" J+ P% e1 z& k! }+ i% `& t, NMyr = 500 '需人工设定
' Z$ z$ s- P. y6 K ^For i = 1 To Myr
3 r) g% X7 R- K* s0 n2 k4 Pd(ExcelSheet.Application.Cells(i, 1).Value) = ExcelSheet.Application.Cells(i, 2).Value. K# I h! H1 N
Next2 Y0 s4 Z- W1 a; O
'结束
+ s5 S# T0 O: a! F7 }; ~2 F( M9 Z" w. h1 l Y* x1 m; i) s
'将字典数据逐个写入到零件开始
( K1 w6 {- H* P& A7 l* R' K. }1 _2 LDim swApp As Object
) a: t/ l2 }+ \/ n8 D. H, jDim Part As Object
3 F. Z, S! Q p9 WDim longstatus As Long, longwarnings As Long- J: | h: l7 Y) c* n& r! W& ^
Dim myPath$, myFile$
: k/ z5 }4 a1 Z0 \. G, ~1 m% l' v* @) z* {/ I
Set swApp = _
1 e: u$ g' M6 J5 C7 @Application.SldWorks
! r. c) O5 \& j/ ]+ q( RmyPath = "C:\Users\Administrator\Desktop\1\" '..........................重点:把文件路径定义给变量
5 ~; l& e; h4 XmyFile = Dir(myPath & "*.sldprt") '依次找寻指定路径中的*.文件
- W" R; M9 k- @' f4 y6 I, wDo While myFile <> ""# S8 q0 F1 {0 g0 }4 b y
Set Part = swApp.OpenDoc6(myPath & myFile, 1, 0, "", longstatus, longwarnings)9 L: v9 F4 J3 N3 G
! r4 x; h- i! B( M, C '单个零件写入数据开始7 X; N ?- u; F
'Dim swApp As Object4 ^/ k( E5 F( h, C- X7 u
Dim c As String3 P( E: k# h1 _! O
Set swApp = Application.SldWorks
) I- M( w6 ^( E4 T) t! `' MSet Part = swApp.ActiveDoc8 G7 @# y: U$ L# a7 v3 }: k* M% m* R
c = swApp.ActiveDoc.GetTitle() '零件名
# Z4 @8 U. {6 ?4 sblnretval = Part.AddCustomInfo3("", "数量", swCustomInfoText, d.Item(c)): B4 I1 N! ^: Z7 _9 t
'单个零件写入数据结束
7 g; U3 g. [: X+ G$ D& x1 G
5 F2 {! H: x ^0 j$ x1 A# q6 APart.Save: [' R. F9 ~6 X4 p
swApp.CloseDoc myPath & myFile' l( Q5 B2 c5 n/ _2 a: p% D
myFile = Dir '找寻下一个*.文件3 E2 c% A9 k! P% k2 E
Loop/ `! l/ T. n2 z" s9 Y6 B+ O* D0 n
'将字典数据逐个写入到零件结束! q. R2 P e2 E! P7 @4 M
End Sub; ]* J4 I" i' \0 H8 f
|