思路是将SW的BOM表导入到EXCEL，然后将EXCEL的数据（零件名+数量）写入到字典，然后通过文件名来匹配到字典里存的数据（数量）写入到零件的数量属性。其中提示请输入数据时需要粘帖数据进来。Myr = 500 '需人工设定。欢迎大家进行补充、使程序更智能。
" \2 ?0 U- t. Z9 A
' }+ I: g2 h' i, v! k# oSub main(): M$ P: }6 X2 V' ^
'打开EXCEL表格开始. T* ?2 ~0 W+ T+ }
Dim ExcelSheet As Object
7 V( P8 R5 g! w8 \2 I" qSet ExcelSheet = CreateObject("Excel.Sheet")8 v/ N& ~5 r' y. p1 U0 v
ExcelSheet.Application.Visible = True
3 o! F- F8 b% y1 l% L( u% H d'结束# |! r; Y. l) I, u' F
' i1 F# z% U% C1 m r. c
'填入数据开始
& g" [5 D6 c& R2 |. ]8 SDim d
/ V& x( {& S4 ~6 B5 F7 z: ?- uSet d = CreateObject("Scripting.Dictionary"); w: K, r3 U9 S1 \; _* q6 N
MsgBox "请输入数据"
9 g) K' F2 C) g'结束. N& b6 j. U3 m/ n; N6 o
8 t0 [2 F2 d6 a7 U9 j'数据写入字典开始, Y# ?( {% I; W; B/ {
Dim Myr&
5 x0 E# y* P# J5 m# T8 f! wMyr = 500 '需人工设定
) c( ?) f1 C0 t4 F1 d( m) VFor i = 1 To Myr# Y3 X/ A# m( t% b: f; ^+ U! e% _
d(ExcelSheet.Application.Cells(i, 1).Value) = ExcelSheet.Application.Cells(i, 2).Value8 k8 {5 q% l4 j6 ]
Next
7 a4 b+ c0 i7 s! f- J. U'结束
% d, G" ~9 I( o- F8 O s# G5 V( h5 U; M$ S) ^$ ?; D: C$ k, T
'将字典数据逐个写入到零件开始
% X* h# A: h. ?, zDim swApp As Object
' D" L% g! M) r( x2 dDim Part As Object% _' [+ M Q/ y( M0 V# Y- A
Dim longstatus As Long, longwarnings As Long
5 e" ]5 R: X8 Q9 [- cDim myPath$, myFile$
3 k5 Z e5 |! t- A& r" \
4 n& H. @, N" z) K! ^0 y; KSet swApp = _! f% F o% b) `9 d- d9 {
Application.SldWorks" Z4 X& p/ m# q0 k1 O/ F$ g
myPath = "C:\Users\Administrator\Desktop\1\" '..........................重点：把文件路径定义给变量
+ l! p1 n L8 Y0 X$ wmyFile = Dir(myPath & "*.sldprt") '依次找寻指定路径中的*.文件
7 s2 \6 h2 V* i* U+ t VDo While myFile <> ""0 T5 ~2 m- U/ c0 f* K5 e
Set Part = swApp.OpenDoc6(myPath & myFile, 1, 0, "", longstatus, longwarnings): s( g$ D3 @; R4 Z" v; m
# ?% I0 u/ s" P0 _0 `9 u3 s '单个零件写入数据开始
7 j6 n5 r2 w% X4 x" |( O- O# ?/ j'Dim swApp As Object5 b7 u p7 k: i n6 P
Dim c As String
% `2 e: B: O$ n, |Set swApp = Application.SldWorks& v' o$ n/ F ~
Set Part = swApp.ActiveDoc0 ^8 V! N; t* V- ~ `3 ]2 ]! \
c = swApp.ActiveDoc.GetTitle() '零件名. v% [! k: e! ~1 |1 e
blnretval = Part.AddCustomInfo3("", "数量", swCustomInfoText, d.Item(c))
# q2 z5 x4 W. A! k. j '单个零件写入数据结束
/ N. Y$ M: L4 ]! K2 t4 Z5 l% B5 `: u% K
Part.Save
4 E; [& |/ t" m$ O# f* i* eswApp.CloseDoc myPath & myFile/ }& y! h9 M3 ^: D5 k, Y" B6 P
myFile = Dir '找寻下一个*.文件( ]+ g+ R6 s- ]+ L* F
Loop! T$ a7 t9 a, c
'将字典数据逐个写入到零件结束
5 F8 m/ `" q" i. l9 L' c9 [6 pEnd Sub& W3 _! m' K6 T) e+ y" d2 N
|
发表于 2019-3-2 12:47:00
