思路是将SW的BOM表导入到EXCEL，然后将EXCEL的数据（零件名+数量）写入到字典，然后通过文件名来匹配到字典里存的数据（数量）写入到零件的数量属性。其中提示请输入数据时需要粘帖数据进来。Myr = 500 '需人工设定。欢迎大家进行补充、使程序更智能。5 I! a5 M1 ^1 C2 b
5 b- {1 t1 Q9 O$ t v
Sub main()4 a# [7 r8 ?* S& h4 W
'打开EXCEL表格开始
5 A3 x6 X3 S# }0 @9 @0 R% h8 n% zDim ExcelSheet As Object
8 m6 K! e$ V4 M* ^) y" SSet ExcelSheet = CreateObject("Excel.Sheet")
2 N' ]! }3 l s9 p# `% E$ FExcelSheet.Application.Visible = True
7 o4 \7 B- A% J'结束" I1 f, m$ v2 l
2 {+ s* y! J& r2 _' g
'填入数据开始
3 n- W2 x/ X0 E" g- h) z0 rDim d
5 P% Y. X# }3 c5 ]5 wSet d = CreateObject("Scripting.Dictionary")
# o8 G) U5 ?* x; m6 zMsgBox "请输入数据"
/ r3 B0 f+ N+ K; U6 U'结束5 x2 r3 d2 g. z6 {
, h% G6 Q" Z8 {& y'数据写入字典开始
0 |. l5 v: R# p8 V# h& WDim Myr&
, q3 G! f9 [* c C& rMyr = 500 '需人工设定
$ j* i; Z5 Y9 o% w" p* JFor i = 1 To Myr: `+ W2 B0 ]0 }. y) ^
d(ExcelSheet.Application.Cells(i, 1).Value) = ExcelSheet.Application.Cells(i, 2).Value2 h! g. g( \( b; P( i1 m
Next
0 q% j6 s# N( u. N8 M2 l1 e5 X'结束; ] d, m9 l: i" B
7 F0 p) ~2 T7 B'将字典数据逐个写入到零件开始
; a y9 M. a! U! L+ T8 kDim swApp As Object
( ?+ S A' {: Y2 r* p- NDim Part As Object
' A* B$ {+ Y- p B7 \) X' }. m9 \* HDim longstatus As Long, longwarnings As Long: A6 O: J- P( T' P4 @' L
Dim myPath$, myFile$
7 t% I/ F( @! Y, x0 e* ~$ p: B6 R8 }3 ?3 J) g5 V
Set swApp = _
* q0 V+ `# K4 z9 D* u: F& c, AApplication.SldWorks u4 X# H3 m0 s" s2 ^# C. r
myPath = "C:\Users\Administrator\Desktop\1\" '..........................重点：把文件路径定义给变量
4 X, Q$ l. G& R0 O( YmyFile = Dir(myPath & "*.sldprt") '依次找寻指定路径中的*.文件
9 A& m( @/ P& ~; d$ m% WDo While myFile <> ""
( d5 c1 N8 e& i; MSet Part = swApp.OpenDoc6(myPath & myFile, 1, 0, "", longstatus, longwarnings)( D8 ~2 v8 a9 i8 s
& n. q: g& P! m$ ]) b
'单个零件写入数据开始6 R9 h9 z+ i0 t' B7 \2 f5 T
'Dim swApp As Object' m6 s" o; ~# ?
Dim c As String
4 t5 X H2 M ~9 h8 T7 r# YSet swApp = Application.SldWorks
3 p# y( u0 T6 B, R" O4 [$ u6 WSet Part = swApp.ActiveDoc& I; P% `) C0 }" @$ c0 S/ c
c = swApp.ActiveDoc.GetTitle() '零件名
' t' U, j' X2 A5 H6 o$ `" jblnretval = Part.AddCustomInfo3("", "数量", swCustomInfoText, d.Item(c))
5 c- i8 \ r8 Z+ i. i6 T! N. S$ F '单个零件写入数据结束! n7 H$ y1 f# u8 c6 [5 p
# R* N0 ]5 O3 f/ _; UPart.Save! g. [9 ]5 P4 [6 {5 \& a& }
swApp.CloseDoc myPath & myFile1 G8 q: k E: l7 l- E! Q
myFile = Dir '找寻下一个*.文件
3 J0 p8 X8 e j# e, y( m7 U6 oLoop
4 n7 J7 f* d9 U s1 V# \'将字典数据逐个写入到零件结束
4 V# I; W9 A0 U; t3 o- F) ~; rEnd Sub
, L y0 M+ b/ N/ z; s% V- r |
发表于 2019-3-2 12:47:00
