思路是将SW的BOM表导入到EXCEL，然后将EXCEL的数据（零件名+数量）写入到字典，然后通过文件名来匹配到字典里存的数据（数量）写入到零件的数量属性。其中提示请输入数据时需要粘帖数据进来。Myr = 500 '需人工设定。欢迎大家进行补充、使程序更智能。) M% O0 r* C5 H W8 `' t2 w- a
# x: g# y _& P% x
Sub main()
7 O/ x8 W0 i& B+ e: B t5 R4 s5 c'打开EXCEL表格开始
: g5 V5 D+ J& ^Dim ExcelSheet As Object0 v; m6 V2 o9 {6 \" n1 S
Set ExcelSheet = CreateObject("Excel.Sheet"): v! u. W; h$ K
ExcelSheet.Application.Visible = True
U/ B& v) P2 l+ E7 W% X'结束
1 }3 w2 c! j6 d( |% s% ?
3 f: ^( W7 l3 v+ F- J8 T9 U5 i'填入数据开始. U$ N2 i# `! E# x4 B& n
Dim d8 M0 C. s& S- \
Set d = CreateObject("Scripting.Dictionary")
% v; c. z( x! `( nMsgBox "请输入数据"
# E9 E1 X5 ? m8 @/ g- T'结束1 h Z0 a( Q9 `) Y- v6 X
+ Z- D C) z/ T9 J* D" B'数据写入字典开始% n* o0 }; S- Q+ b$ r' H
Dim Myr&; w9 }: `, e n; k
Myr = 500 '需人工设定
( Z# b2 C9 X) ^9 Q% V0 q, K# |For i = 1 To Myr) ?( c: Q" r( c: f* L5 a
d(ExcelSheet.Application.Cells(i, 1).Value) = ExcelSheet.Application.Cells(i, 2).Value
( C; ?& c! Y/ \7 ]Next
% h3 U/ w' C0 o9 H'结束4 W& V$ |; y* T* R+ C
8 c% a V- ~, h! G7 a5 P'将字典数据逐个写入到零件开始9 Z& O6 E/ b. @% _$ _
Dim swApp As Object
2 }* ^* c' D' I4 G y. M. |: B- `Dim Part As Object0 ~( A4 Q6 h& w T f
Dim longstatus As Long, longwarnings As Long
# }3 [2 [2 q+ v; q4 MDim myPath$, myFile$
1 F7 A4 L$ x3 z; |/ [ J
: G& d1 ?; E, ~: p1 hSet swApp = _ z" v$ Y' W8 z( z& [; g
Application.SldWorks+ n$ u6 i; r( N3 e
myPath = "C:\Users\Administrator\Desktop\1\" '..........................重点：把文件路径定义给变量" z- G; \3 K% K# k
myFile = Dir(myPath & "*.sldprt") '依次找寻指定路径中的*.文件$ W# F0 W7 f% K
Do While myFile <> ""
2 q% g' N% w& Z, G) b- [Set Part = swApp.OpenDoc6(myPath & myFile, 1, 0, "", longstatus, longwarnings)! P; y$ }5 B+ ~7 z$ \6 k
" I2 f# W2 m7 C '单个零件写入数据开始0 Z7 i4 ?' ?" X1 A l; @1 a0 H- o% |! P
'Dim swApp As Object2 w1 Z' H* g# O( Y5 I7 g/ L
Dim c As String
! q6 z" _* g q& ASet swApp = Application.SldWorks. k8 F2 h7 l& N6 h8 a/ P; O }
Set Part = swApp.ActiveDoc
2 \% K* y9 @- Z. A! Y" |7 S1 I: [c = swApp.ActiveDoc.GetTitle() '零件名+ M( L! x; J+ ]1 k4 L
blnretval = Part.AddCustomInfo3("", "数量", swCustomInfoText, d.Item(c))
7 G5 ^8 h: D* X* T, P5 d+ k& ? '单个零件写入数据结束
$ e, b% S! V3 i0 Z- a, \% S6 Y0 F4 H$ i; p. A
Part.Save
3 _3 M/ i2 m7 e* lswApp.CloseDoc myPath & myFile
! |: ]( R* K r( o0 T+ gmyFile = Dir '找寻下一个*.文件
! U& T# D/ f6 H- FLoop$ Q) G: b1 Q# F
'将字典数据逐个写入到零件结束0 y) h2 Q8 ^$ u1 C: |7 q* N
End Sub
1 B4 k6 A) O! `% s |
发表于 2019-3-2 12:47:00
