solidworks的VBA问题

dajian1984 · 发表于 2023-4-21 22:34:46

我打的程序无法运行，有没有懂的人帮我看看！谢谢。

Dim swapp As Object
Dim part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim pathstr As String
Dim fname(500) As String, fnum As Long
Sub main()
Dim i As Long
Dim pathstr0 As String, pathstr1 As String
Dim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
Dim L As Long, L1 As Long
pathstr = InputBox("请输入需要转的工程图所在位置")
Call Showfilelist(pathstr)
Set swapp = Application.SldWorks

For i = 0 To fnum - 1
pathstr0 = pathstr & "\" & fname(i)

Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)

L = Len(pathstr0)

pathstr1 = Left(pathstr0, L - 7) & ".DWG"

pathstr2 = Left(pathstr0, L - 7) & ".PDF"

longstatus = part.SaveAs3(pathstr1, 0, 0)

longstatus = part.SaveAs3(pathstr2, 0, 0)

Set part = Nothing

L1 = Len(fname(i))

pathstr3 = Left(fname(i), L1 - 7) & "- 图纸1"

pathstr4 = Left(fname(i), L1 - 7) & "- 图纸2"

pathstr5 = Left(fname(i), L1 - 7) & "- 图纸3"

swapp.colsedoc pathstr3

swapp.colsedoc pathstr4

swapp.colsedoc pathstr5

Next i

End Sub

Private Sub Showfilelist(folderspec As String)

Dim fs, f, f1, fc, s

Set fs = CreateObject("scripting,filesystemobject")

Set f = fs.getfolder(folderspec)

Set fc = f.files

fnum = 0

For Each fi In fc

If InStr(f1.Name, "slddrw") > 0 Then

fname(fnum) = f1.Name

fnum = fnum + 1

End If

Next

End Sub

steve_suich · 发表于 2023-4-25 09:06:09

Dim swapp As Object8 l8 s- n( S) x6 O E
Dim part As Object
! z0 ]# N# ~# D7 z
Dim boolstatus As Boolean7 V9 W) a, t" e
Dim longstatus As Long, longwarnings As Long% i2 f- G! x8 ~3 J4 V' U
Dim pathstr As String, [; i: G6 f- U0 v2 t
Dim fname(500) As String, fnum As Long) g @+ ~/ f. J7 ^
Sub main()7 g% T% j2 t8 g3 }
Dim i As Long
" r( ?& w# I+ N1 B9 Y6 @, j
Dim pathstr0 As String, pathstr1 As String
. R5 l( u! J E& D
Dim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
6 ^9 A$ [5 o( k" ~8 x) j
Dim L As Long, L1 As Long# m1 v$ w* U6 O' X8 ^
pathstr = InputBox("请输入需要转换的工程图所在位置")
9 d/ f0 \/ r8 i6 b6 n0 K1 s
Call Showfilelist(pathstr)( `- h7 A7 v3 f* o
Set swapp = Application.SldWorks
* m) i) C! B* q0 ~- ]# S4 f& b8 x
# F2 Y; M$ k( h' r* T6 g/ x
For i = 0 To fnum - 1: H2 Q( \4 {0 v6 d
pathstr0 = pathstr & "" & fname(i)
; \+ u3 v( z9 D8 e/ ^% n6 Y. y% E
7 B$ ?' j( N; v% ^
Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)) I$ P8 X$ X, N0 K
L = Len(pathstr0)
: e3 K3 _; }9 E% Z+ }/ Y
; h: t8 W+ `) Z& R2 _1 \# L
pathstr1 = Left(pathstr0, L - 7) & ".DWG"
% A" l) Z7 m) y
2 q. i4 r8 e- F& S5 s! j
pathstr2 = Left(pathstr0, L - 7) & ".PDF"
2 s. V/ R k' I. ~" r
+ u* [3 m- I7 E
longstatus = part.SaveAs3(pathstr1, 0, 0)
" s0 L' L# ?7 C7 ]# H
longstatus = part.SaveAs3(pathstr2, 0, 0)8 }. D T6 m9 g
; m; O; o1 U" X! @8 [: A
swapp.CloseDoc pathstr0; p# j7 X" l. [; {" ^, L: k" ~
3 h3 ~# Q% k! I( q
Next i [# g3 l% J' R7 h8 M' Y T2 d& g
( e5 P8 b4 o' \% R- q* \
End Sub% s+ d% _0 w6 M/ M. k* M
2 [3 H0 Y3 A3 V
Private Sub Showfilelist(folderspec As String)
$ J K7 ^$ \5 A6 ^$ ]) X
Dim fs, f, f1, fc, s
1 S p1 E7 Y& l8 X: X
1 X# n- F$ H1 ^# g
Set fs = CreateObject("Scripting.filesystemobject")
( ^, |8 c9 O; V/ q
1 V" s2 U1 S. ?- g% N4 j& e0 ~
Set f = fs.getfolder(folderspec)
6 I. G3 b. q8 @
3 y6 m- d% X2 I) _' `! G
Set fc = f.files
& I2 _/ h- a+ ]( _+ X% ~0 `' H: P
- T V& Y0 D2 U; W2 D
fnum = 0
/ L- e- o7 t+ F
V' W! P- ^2 n% J
For Each f1 In fc
: w; Z9 ^6 \1 j# o- R! B! F
If InStr(UCase(f1.Name), "SLDDRW") > 0 Then3 P5 S x4 y6 p' M% a& d
fname(fnum) = f1.Name
4 b- p4 Q4 D( J3 {0 X: z" d5 h
fnum = fnum + 1
% l2 C/ \, g4 N2 W0 w1 O U
8 i. z" X# D2 E9 q4 U6 J g. }
End If
- A' i4 {+ \$ R) \: f$ B% }
9 w0 c( ^+ H6 I% P5 B% H
Next
) n( J- A8 r& i4 v* x( e
. u* C/ U6 U. X) m
End Sub+ [, a! W" y* S2 ?

复制代码

steve_suich · 发表于 2023-4-25 09:07:53

本帖最后由 steve_suich 于 2023-4-25 09:10 编辑

swapp.colsedoc 应为swapp.closedoc
Scripting,filesystemobject应为Scripting.filesystemobject
判断slddrw时，应先全部转换为大写，再进行判断。

dajian1984 · 发表于 2023-4-25 09:35:37

steve_suich 发表于 2023-4-25 09:07- n0 j4 o( _/ u- @: V2 M% ^: Z
swapp.colsedoc 应为swapp.closedoc
1 \! u) H/ \9 C5 g7 ~" iScripting,filesystemobject应为Scripting.filesystemobject
6 j/ q7 ]2 M3 S0 t判断sld ...

谢谢。

		自动登录	找回密码
密码			注册会员