solidworks的VBA问题

dajian1984

我打的程序无法运行，有没有懂的人帮我看看！谢谢。
2 t, k+ u1 [8 J% u# H1 T8 @
Dim swapp As Object
Dim part As Object
( A* y) p' I, X) F/ EDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
; N* t9 w+ S5 u( J2 SDim pathstr As String
Dim fname(500) As String, fnum As Long
5 I. l9 |. f" f$ P: TSub main()
& _8 Y$ E+ L4 g! ~. sDim i As Long
, E! k0 \' |; O/ |4 VDim pathstr0 As String, pathstr1 As String
" L% {# o* |' ^0 |+ J+ b9 i6 a4 UDim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
) L" l6 m5 l2 e6 f( Y9 Y' @5 h2 zDim L As Long, L1 As Long
1 [$ q) C, ~; apathstr = InputBox("请输入需要转的工程图所在位置")
Call Showfilelist(pathstr)
Set swapp = Application.SldWorks
1 V- A1 s0 s" Z7 Y+ l
For i = 0 To fnum - 1
0 n3 k; G: u* |) M0 lpathstr0 = pathstr & "\" & fname(i)

: ~: L9 k0 q! m, A, H2 B* ^Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)

( ?- h: y. s4 [4 [/ q- Q# A5 ML = Len(pathstr0)
+ ^( W5 q/ K7 P7 z8 n" \
6 V, l' i, V7 Q+ }. Xpathstr1 = Left(pathstr0, L - 7) & ".DWG"

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

& x" O! X& Y% N4 rlongstatus = part.SaveAs3(pathstr1, 0, 0)
5 O0 H3 _7 q x2 N$ B
3 y. Y* P* \ k2 N& i2 P9 F$ vlongstatus = part.SaveAs3(pathstr2, 0, 0)

0 t; q# A0 j6 Y9 I1 h: _! }* \Set part = Nothing
" r$ q2 A" R& m! m( h, |3 v
% a! T- p1 C1 KL1 = Len(fname(i))

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

! x# E" y# w6 h% J6 \& Z. k" Bpathstr4 = Left(fname(i), L1 - 7) & "- 图纸2"
3 R: _2 L1 Q; W. a4 D' w
' a/ L; K' U& O d7 V" c7 Upathstr5 = Left(fname(i), L1 - 7) & "- 图纸3"

0 F5 B; M( Q9 l6 sswapp.colsedoc pathstr3

swapp.colsedoc pathstr4

# t. T* {" e- B8 a: ^+ T9 {swapp.colsedoc pathstr5
s, }! v) }8 H. U5 R
Next i
$ c2 X2 E, i! B* n0 k% S6 C& B+ Y

+ L% \# b# O9 ?; f9 \% z* qEnd Sub
2 R3 H+ \) e: A' e% f

Private Sub Showfilelist(folderspec As String)

0 E$ i- W, q: n1 n( x) h& y! m0 S0 L
Dim fs, f, f1, fc, s

Set fs = CreateObject("scripting,filesystemobject")
! h# o0 S& c$ B& t, m
Set f = fs.getfolder(folderspec)

5 A% f% {9 k/ }$ o7 GSet fc = f.files

" K* V9 }8 D% N2 ]% Ffnum = 0
8 V9 E4 W( z" N; |& W6 p
For Each fi In fc
& A' s8 L# V9 _0 w" U* Z+ \
- F4 i5 \; [9 N$ t' t2 PIf InStr(f1.Name, "slddrw") > 0 Then
* x9 }0 Y+ ]1 |) s+ V! e+ i* o
fname(fnum) = f1.Name

fnum = fnum + 1
X# q) m) k' K: b
( ?' P7 }9 g1 i7 JEnd If
. g1 b% @, T1 ?( \) A
# _% n2 V, Q+ `9 Q {5 O- s- F7 PNext
$ D4 |8 ^/ {5 x- U3 E
End Sub

k) Z5 e) H! x% [1 T

steve_suich

1. Dim swapp As Object
   
2. Dim part As Object
   ! U9 g6 ^& E( l5 n
3. Dim boolstatus As Boolean
   . q, Q# e. Y% u( E* N! E4 M
4. Dim longstatus As Long, longwarnings As Long
   9 P4 @) V" A7 b; o: |. P
5. Dim pathstr As String
   
6. Dim fname(500) As String, fnum As Long
   + g' I! x1 F5 M: m2 v; i
7. Sub main()
   
8. Dim i As Long
   * _ g- C% @' K U! M& R
9. Dim pathstr0 As String, pathstr1 As String
   
10. Dim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
    ; s5 _$ l1 g& k0 v# N6 q
11. Dim L As Long, L1 As Long
    
12. pathstr = InputBox("请输入需要转换的工程图所在位置")
    
13. Call Showfilelist(pathstr)
    
14. Set swapp = Application.SldWorks
    $ f. ^$ j! G! L% k6 J9 U. J
15. 
    5 G( g) _9 H) N4 ~: e/ M5 b1 t+ X+ B
16. For i = 0 To fnum - 1
    , g# s; T, ^5 I" P/ G" D" w
17. pathstr0 = pathstr & "" & fname(i)
    4 y4 y- h7 R1 ?. L( c
18. 
    
19. Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
    9 R/ v* T/ T8 {$ ]& a
20. L = Len(pathstr0)
    
21. 
    
22. pathstr1 = Left(pathstr0, L - 7) & ".DWG"
    
23. 
    1 [( P% B+ e M9 I7 F
24. pathstr2 = Left(pathstr0, L - 7) & ".PDF"
    % x- o) S+ L6 t; Y$ {- G7 k9 ]& a5 [
25. 
    % g& P, l' R& [( U) |9 [2 O
26. longstatus = part.SaveAs3(pathstr1, 0, 0)
    
27. longstatus = part.SaveAs3(pathstr2, 0, 0)
    
28. 
    
29. swapp.CloseDoc pathstr0
    
30. 
    
31. Next i
    7 A! a$ |% Q: |& h2 z
32. 
    # o! w* R& d$ v( a% x+ P; M, G, G
33. End Sub
    
34. 
    
35. Private Sub Showfilelist(folderspec As String)
    
36. Dim fs, f, f1, fc, s
    + K) O5 q6 h$ c1 C) Z; a
37. 
    
38. Set fs = CreateObject("Scripting.filesystemobject")
    - r" Q4 M/ l9 e% e5 W0 `
39. 
    ( w B6 I( |; {4 W- `3 P) a4 p
40. Set f = fs.getfolder(folderspec)
    
41. 
    
42. Set fc = f.files
    
43. 
    
44. fnum = 0
    ; Y. W" R' |; |% _
45. 
    8 d: s! i3 E! a5 K! O
46. For Each f1 In fc
    
47. If InStr(UCase(f1.Name), "SLDDRW") > 0 Then
    
48. fname(fnum) = f1.Name
    
49. fnum = fnum + 1
    
50. 
    
51. End If
    
52. 
    
53. Next
    
54. 
    
55. End Sub
    ( |' b; z+ U2 f3 g; ~8 z2 R

复制代码

$ @6 _8 z2 l6 x3 I1 Q: d
" Q' J7 _9 `8 w( W$ X3 N

steve_suich

5 q: j, B6 `" }2 wswapp.colsedoc 应为swapp.closedoc
6 {0 M/ R }% PScripting,filesystemobject应为Scripting.filesystemobject
% y) z' Y4 F6 P- ^; N( Q判断slddrw时，应先全部转换为大写，再进行判断。

dajian1984

steve_suich 发表于 2023-4-25 09:07
% ] R: L8 b2 d- xswapp.colsedoc 应为swapp.closedoc
Scripting,filesystemobject应为Scripting.filesystemobject
5 b9 y8 N- p' H5 W0 p. A判断sld ...

; f0 i4 L, p/ @1 b; o谢谢。
& H; A5 v5 G2 r2 m