solidworks的VBA问题

dajian1984

我打的程序无法运行，有没有懂的人帮我看看！谢谢。
4 ?  m) g% ~& r' q4 H
Dim swapp As Object
) H$ {) B( H6 p' w6 P2 LDim part As Object
Dim boolstatus As Boolean
1 }; s; O# M" n; G- t; wDim longstatus As Long, longwarnings As Long
Dim pathstr As String
) e" J# f5 t8 j% d' @$ _Dim fname(500) As String, fnum As Long
' H  _3 ]  w) D- e3 B. v' l; E5 qSub main()
4 {4 y  C2 g9 \Dim i As Long
Dim pathstr0 As String, pathstr1 As String
( t) o" R6 x2 P6 L$ EDim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
Dim L As Long, L1 As Long
5 Z, T& M5 q6 _, f2 bpathstr = InputBox("请输入需要转的工程图所在位置")
; O  `9 i( _/ I7 g' x- \# JCall Showfilelist(pathstr)
. Z; o$ N8 _* A/ q$ s/ U6 o. TSet swapp = Application.SldWorks

For i = 0 To fnum - 1
  ^) B4 W+ H2 Upathstr0 = pathstr & "\" & fname(i)
- H8 ?9 k& U# `# d# S
Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)

L = Len(pathstr0)
6 N: F( F# S  U. Q: [* o
pathstr1 = Left(pathstr0, L - 7) & ".DWG"
  ^  p* g# K: D+ Q0 O
pathstr2 = Left(pathstr0, L - 7) & ".PDF"

1 U& w0 s3 I" E4 olongstatus = part.SaveAs3(pathstr1, 0, 0)
& @6 A0 }* m  E- q' n/ ?$ ^7 R
longstatus = part.SaveAs3(pathstr2, 0, 0)

Set part = Nothing

L1 = Len(fname(i))
) v' U/ t. p) D2 }7 h- i* `
pathstr3 = Left(fname(i), L1 - 7) & "- 图纸1"

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

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

. M, a4 g9 h/ R$ U" Vswapp.colsedoc pathstr3

! l1 s0 |& {! @% m' \: ~. lswapp.colsedoc pathstr4

swapp.colsedoc pathstr5
$ d& n) O: C8 m
Next i
* U3 p+ ?9 k! V; p1 C! J
& q1 z* x( f" F% U) U* K
End Sub
: C# H% Z8 _: c% X8 x

Private Sub Showfilelist(folderspec As String)
) r  U# U5 ^& f/ K! r( i& c
0 c+ x7 z6 C% L1 s0 }
Dim fs, f, f1, fc, s

3 l/ c/ _7 M1 I- lSet fs = CreateObject("scripting,filesystemobject")
* C! q% L, _$ }* H& e$ [1 d; F
# _# J( S6 }' s) ]3 g; q7 [Set f = fs.getfolder(folderspec)
; G: @+ r+ E& C" ]1 o2 E
: S, ~' m' D2 A* C8 c  v3 M  SSet fc = f.files
8 M/ v* g4 |+ O2 m+ ]1 v  n, t4 V
) x* E# K# {8 y% ]fnum = 0

' N* \1 y3 n' KFor Each fi In fc

, Z+ Y* {" v  j& W( E: A% t2 NIf InStr(f1.Name, "slddrw") > 0 Then
4 @# K* W3 ]$ y5 R
4 L0 w7 X  \1 Zfname(fnum) = f1.Name

fnum = fnum + 1
- ?9 H, S; M- \
! _' c- ~* R% U: L- A& gEnd If
2 F6 K7 |7 x1 B/ t- P
% V% t- Q' ?7 a+ n6 ?' tNext

) s! t( V; J: h7 d5 M$ h7 W% {  VEnd Sub

steve_suich

1. Dim swapp As Object
   2 K5 P+ j6 g# D  j8 {( O. v/ \
2. Dim part As Object
   9 x. e( O( u7 k' w
3. Dim boolstatus As Boolean
   ) w9 [6 a+ p4 e4 w6 V! N
4. Dim longstatus As Long, longwarnings As Long
   
5. Dim pathstr As String
   6 p2 f; t! O$ J) ~1 @8 `  r' y1 j
6. Dim fname(500) As String, fnum As Long
   ; p. h0 f2 ?: H4 Z# Q; ]( \* l
7. Sub main()
   
8. Dim i As Long
   
9. Dim pathstr0 As String, pathstr1 As String
   , b5 D* k# [1 d8 n- I' o. X
10. Dim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
    / z$ s9 j. _5 _% l
11. Dim L As Long, L1 As Long
    
12. pathstr = InputBox("请输入需要转换的工程图所在位置")
    
13. Call Showfilelist(pathstr)
    + X: h5 ~' H( p, [9 e) _) w
14. Set swapp = Application.SldWorks
    5 H% j# f# b+ t' w1 M: U$ d" g' y
15. 
    8 q# V9 C6 _0 Q6 G
16. For i = 0 To fnum - 1
    
17. pathstr0 = pathstr & "" & fname(i)
    
18. 
    - s( z1 s& Q$ b
19. Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
    ; Y: ?5 o; [$ }# `' }( Y
20. L = Len(pathstr0)
    
21. 
    
22. pathstr1 = Left(pathstr0, L - 7) & ".DWG"
    
23. 
    
24. pathstr2 = Left(pathstr0, L - 7) & ".PDF"
    
25. 
    ( W! w$ `; t6 K; _% O4 ]& i3 Y9 N% u
26. longstatus = part.SaveAs3(pathstr1, 0, 0)
    # _  G+ t8 v3 x. `
27. longstatus = part.SaveAs3(pathstr2, 0, 0)
    
28. 
    
29. swapp.CloseDoc pathstr0
    
30. 
    
31. Next i
      a: Q1 |& N( h) v& ]
32. 
    3 t6 k6 }6 c2 E6 B- K: J6 c
33. End Sub
    
34. 
    ! Y! q+ W! h% D4 }
35. Private Sub Showfilelist(folderspec As String)
    5 X4 ~& e# p6 G. l( P. v
36. Dim fs, f, f1, fc, s
    0 l  f3 w: h* f( \( I+ l* z6 R
37. 
    3 P# F3 `8 E6 p3 Y3 h% p
38. Set fs = CreateObject("Scripting.filesystemobject")
    4 e5 p( x/ X" q/ }' t, y
39. 
    
40. Set f = fs.getfolder(folderspec)
    
41. 
    
42. Set fc = f.files
    
43. 
    
44. fnum = 0
    
45. 
    $ m/ A; u$ F1 Z. x6 A
46. For Each f1 In fc
    " _) D/ ], |/ a' U
47. If InStr(UCase(f1.Name), "SLDDRW") > 0 Then
    
48. fname(fnum) = f1.Name
    
49. fnum = fnum + 1
    
50. 
    
51. End If
    3 R) b4 Z; C9 _2 j" t
52. 
    
53. Next
    4 p" z; ?( N  u2 _2 Z  N
54. 
    
55. End Sub
    7 Z) K/ p* b$ j- ?. j5 w: @, w

复制代码

, A, e0 T% A9 N* f9 P8 V  X

steve_suich

swapp.colsedoc 应为swapp.closedoc
0 M0 y$ V# g% I8 tScripting,filesystemobject应为Scripting.filesystemobject
判断slddrw时，应先全部转换为大写，再进行判断。

dajian1984

steve_suich 发表于 2023-4-25 09:07
swapp.colsedoc 应为swapp.closedoc
Scripting,filesystemobject应为Scripting.filesystemobject
判断sld ...

: F( C6 ^6 s. I$ k1 ^# l3 h谢谢。