solidworks的VBA问题

dajian1984

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

2 @8 p0 H; K7 H* ODim swapp As Object
Dim part As Object
! [5 O: V2 |" v4 K& CDim boolstatus As Boolean
# r0 w3 d* F. x4 \- y) tDim longstatus As Long, longwarnings As Long
Dim pathstr As String
) h# m8 o) `5 M9 a) A% |Dim fname(500) As String, fnum As Long
Sub main()
- j" y$ B+ y* D) k) M% f8 p" z( I4 jDim i As Long
Dim pathstr0 As String, pathstr1 As String
Dim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
6 Y! L4 w- P# O( nDim L As Long, L1 As Long
* ~( I$ O: }. H& }& Rpathstr = InputBox("请输入需要转的工程图所在位置")
+ e1 F, R! U. ^: BCall Showfilelist(pathstr)
) a7 b. @" O4 _; d  u) `Set swapp = Application.SldWorks
  t2 s% Y  J+ w+ A; P* r
For i = 0 To fnum - 1
0 ^% J. D+ ?  G; V% tpathstr0 = pathstr & "\" & fname(i)

* v5 ]6 K' Y' t9 rSet part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
5 b; k! _- G4 [& E" `$ d- F
L = Len(pathstr0)
& ]. v5 t# g/ Y
pathstr1 = Left(pathstr0, L - 7) & ".DWG"
6 e  g$ }  M# D8 E% Y
; g0 o* B; f6 U- Lpathstr2 = Left(pathstr0, L - 7) & ".PDF"

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

* w" V" _# W" U4 ~" O& u. W6 \longstatus = part.SaveAs3(pathstr2, 0, 0)

/ `) W# Y7 O1 }7 o. [! ]- {1 C% wSet part = Nothing

" Z9 ~) ?# u7 a- O/ c0 LL1 = Len(fname(i))
% S; W" Q- \/ F1 o& E/ }
pathstr3 = Left(fname(i), L1 - 7) & "- 图纸1"
7 N( F+ \, l* P. D' n* Y6 A( O
, F* d* {$ Y& m  w' U$ W# Rpathstr4 = Left(fname(i), L1 - 7) & "- 图纸2"
5 L* l; S' l- t2 ~; }
pathstr5 = Left(fname(i), L1 - 7) & "- 图纸3"

swapp.colsedoc pathstr3
, ?: t( s0 j; a* \* I$ n
& i5 l! |3 J  C& }" k; {+ l1 fswapp.colsedoc pathstr4
3 l1 S1 _8 ]0 m) `) ?1 h8 n
swapp.colsedoc pathstr5
; \; F5 o, Q5 @, g) o4 z* a% }
. K3 k9 ~& |; a! w& S3 ~; O+ I& XNext i
* r5 ?( s+ \- ~! D% c4 z! j
4 w! ]: e  _. z& J4 u
9 }+ X* |& E. g  g& OEnd Sub

2 C- h" m2 u* n5 [# @2 ?+ \& M) ]
Private Sub Showfilelist(folderspec As String)

: t) I) ]- V# X* e6 t2 \) |5 v1 M7 m
Dim fs, f, f1, fc, s
3 E7 v$ e0 [' g) z
% m& |& o6 v( @$ Y: y  uSet fs = CreateObject("scripting,filesystemobject")

* {1 f2 h- \8 LSet f = fs.getfolder(folderspec)
0 c1 M% F+ b- e' e* }  C6 P+ G
Set fc = f.files
( o" g2 B# t" W/ x
fnum = 0

! e( X! S3 }5 d% hFor Each fi In fc

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

fname(fnum) = f1.Name
5 G3 H9 u  \& \5 \6 j- Z
( W3 r) U6 h  L0 f: h( ~fnum = fnum + 1

End If
9 P; ]- \% F- D
Next
7 W  @: N4 }9 l" g5 }; \% q
" C# S0 ^" b4 @" s" _; W. u4 M% ^$ KEnd Sub
2 w: h8 O- S4 R. t" V7 z
& q" [" ~/ i1 D

steve_suich

1. Dim swapp As Object
   % ]. `" F4 ]0 U0 j6 J
2. Dim part As Object
   
3. Dim boolstatus As Boolean
   
4. Dim longstatus As Long, longwarnings As Long
   * ]* j: x2 }- h% u0 B/ f
5. Dim pathstr As String
   * r  }+ T$ R9 h" T8 r
6. Dim fname(500) As String, fnum As Long
   
7. Sub main()
     V+ v' k' ^; _
8. Dim i As Long
   5 s0 {' K9 ^; R. H% {
9. Dim pathstr0 As String, pathstr1 As String
   ; A' [5 ?9 ~% i# [% f
10. Dim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
    
11. Dim L As Long, L1 As Long
    # u1 X% F" N+ O6 z2 W
12. pathstr = InputBox("请输入需要转换的工程图所在位置")
    9 l- h8 X' ]4 i2 K1 y) M
13. Call Showfilelist(pathstr)
    
14. Set swapp = Application.SldWorks
    7 i6 }: Z1 W0 d. n" Q
15. 
    % u' u, L) @) t( N$ n
16. For i = 0 To fnum - 1
      G& H1 ^. l$ n( d2 K" `
17. pathstr0 = pathstr & "" & fname(i)
    
18. 
    
19. Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
    
20. L = Len(pathstr0)
    & S: B4 n. ?. J$ \
21. 
    2 h( X. h3 U/ k9 B! `0 b
22. pathstr1 = Left(pathstr0, L - 7) & ".DWG"
    ( l( ~5 j" E8 |; D
23. 
    
24. pathstr2 = Left(pathstr0, L - 7) & ".PDF"
    
25. 
    
26. longstatus = part.SaveAs3(pathstr1, 0, 0)
    
27. longstatus = part.SaveAs3(pathstr2, 0, 0)
    
28. 
    
29. swapp.CloseDoc pathstr0
    : A6 Z* A3 w0 `& v' }  G) X' ]
30. 
    + s- v3 A' ^) N0 ~
31. Next i
    
32. 
    , G% Y6 F  V" ^2 j8 I1 t3 L! d- l
33. End Sub
    & Z8 @1 b* O- u, g9 F% B) R# t
34. 
    ; ]7 U6 }0 s, w$ d, |. P
35. Private Sub Showfilelist(folderspec As String)
    * R" m3 Q) f7 E
36. Dim fs, f, f1, fc, s
    1 m' n8 T) Q8 `- }. Y" k" n$ K) o
37. 
    
38. Set fs = CreateObject("Scripting.filesystemobject")
    8 b2 C+ g) b/ h8 q% W. J
39. 
    
40. Set f = fs.getfolder(folderspec)
    % `8 u  W/ E2 X7 W4 C( j& d
41. 
    
42. Set fc = f.files
    & ~- G% b6 \- u
43. 
    
44. fnum = 0
    ; K$ n; `9 I( v( O1 t+ q
45. 
    
46. For Each f1 In fc
    & W8 }4 `* a$ R: R! M
47. If InStr(UCase(f1.Name), "SLDDRW") > 0 Then
    
48. fname(fnum) = f1.Name
    9 ^9 u# ~" t- K. l
49. fnum = fnum + 1
    # F) [; a" ^8 ?. ?8 X9 w) i
50. 
    / `  x4 N( I1 K3 }  M
51. End If
    8 [. f: t9 U' X" ]
52. 
    
53. Next
    
54. 
      C  |  ^/ ^0 \
55. End Sub
    

复制代码

( D: [& t4 U$ ~; c

steve_suich

, d( M4 G- i; sswapp.colsedoc 应为swapp.closedoc
/ _) l/ A' D: N. R9 N! }) YScripting,filesystemobject应为Scripting.filesystemobject
判断slddrw时，应先全部转换为大写，再进行判断。

dajian1984

steve_suich 发表于 2023-4-25 09:07
5 ~! ^0 o( @8 l9 Tswapp.colsedoc 应为swapp.closedoc
" ^0 g+ z" y0 I! q  a! ZScripting,filesystemobject应为Scripting.filesystemobject
8 v' `( H4 r& K" v3 [5 p% L+ @4 K判断sld ...

谢谢。