solidworks的VBA问题

dajian1984

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

6 R$ X- ]& B, GDim swapp As Object
Dim part As Object
- q) ~$ Q4 j: _  n0 ?, HDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim pathstr As String
) X9 y% ?6 ~8 g, t; n! ADim fname(500) As String, fnum As Long
Sub main()
* L( Y8 ?  R8 W' GDim i As Long
Dim pathstr0 As String, pathstr1 As String
4 R$ j# c6 N6 fDim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
& F3 G# z9 V$ `Dim L As Long, L1 As Long
pathstr = InputBox("请输入需要转的工程图所在位置")
Call Showfilelist(pathstr)
Set swapp = Application.SldWorks
! `* E3 S0 N; g
For i = 0 To fnum - 1
2 s. L5 I! v$ p1 |& {' Ipathstr0 = pathstr & "\" & fname(i)
  z, A; ~. x4 P/ ?: r; ?, ]
6 Y! U! ?4 S; z2 D4 ]Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
. r) O* S2 ^8 d# k' s" V: g8 c4 F% ]
L = Len(pathstr0)

pathstr1 = Left(pathstr0, L - 7) & ".DWG"
7 q) @6 n2 E' I% ~7 Q+ t3 J
pathstr2 = Left(pathstr0, L - 7) & ".PDF"
) Q; y  f6 i/ x" g  h: g
longstatus = part.SaveAs3(pathstr1, 0, 0)

longstatus = part.SaveAs3(pathstr2, 0, 0)
  g# V9 p  H3 Q& Y$ G
. g, H: U+ V3 SSet part = Nothing
+ R' T( {) ?( p
L1 = Len(fname(i))
) R1 h; ~: P* g* v/ g2 C0 \, S
pathstr3 = Left(fname(i), L1 - 7) & "- 图纸1"

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

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

7 b1 ]1 A# m7 V* n, R( V! ?( U8 uswapp.colsedoc pathstr3

5 C6 b. x. t& g# p4 I0 J! D- Hswapp.colsedoc pathstr4
0 G- P7 E3 U. E& r1 o* {
swapp.colsedoc pathstr5

Next i


End Sub


Private Sub Showfilelist(folderspec As String)
1 |1 N. i$ J7 D5 w2 q/ _
* v; a( O2 m/ u2 M* U# x7 `
Dim fs, f, f1, fc, s

/ I6 n, z4 l' A. c2 n7 W# t' ISet fs = CreateObject("scripting,filesystemobject")
" J! [6 j% q5 Z- t
Set f = fs.getfolder(folderspec)

Set fc = f.files

fnum = 0
1 |) z8 d% z) l$ G
! L+ [) V9 l* I9 B+ PFor Each fi In fc
) H. D6 p2 s9 k6 z
2 O- S9 \9 r$ K7 `' w  _; i7 ^If InStr(f1.Name, "slddrw") > 0 Then

* X$ O/ \4 g5 }4 P3 tfname(fnum) = f1.Name

/ a- B* v! m: N8 mfnum = fnum + 1
& r# h6 {4 `7 ^
End If

Next

8 a  T% S5 w1 t/ {5 x; A" k; MEnd Sub
- ^; F, p& t6 {2 j
( A# C* }; J* K+ d- d. X& I2 I6 ^

steve_suich

1. Dim swapp As Object
   
2. Dim part As Object
   
3. Dim boolstatus As Boolean
   
4. Dim longstatus As Long, longwarnings As Long
   
5. Dim pathstr As String
   % @) g+ q3 Y2 u- V
6. Dim fname(500) As String, fnum As Long
   
7. Sub main()
   ' X, e+ U' g% B7 Z
8. Dim i As Long
   5 N9 Y" A* e/ R/ y( M& L4 u- U
9. Dim pathstr0 As String, pathstr1 As String
   
10. Dim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
    
11. Dim L As Long, L1 As Long
    ( r7 X3 \( j  h4 M2 F
12. pathstr = InputBox("请输入需要转换的工程图所在位置")
      ^2 \# ~) c2 P/ a8 H% H$ h- a4 ^
13. Call Showfilelist(pathstr)
    # W8 V, A! ?5 m$ C6 t  {, Q( {
14. Set swapp = Application.SldWorks
    ; c1 C2 q3 x2 p
15. 
    
16. For i = 0 To fnum - 1
    
17. pathstr0 = pathstr & "" & fname(i)
    # \/ F, d" p+ t- ?. N. e% I
18. 
    2 }" j% r: m2 I% ~
19. Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
    
20. L = Len(pathstr0)
    9 D% j4 U0 F/ h  \6 y5 T7 _
21. 
    2 X9 k, g, N/ `6 B
22. pathstr1 = Left(pathstr0, L - 7) & ".DWG"
    
23. 
    
24. pathstr2 = Left(pathstr0, L - 7) & ".PDF"
    . Z! ~6 A% ^' \: P; {  L* l3 S3 P
25. 
    8 |, ~' t9 m' |- o! l, F
26. longstatus = part.SaveAs3(pathstr1, 0, 0)
    ; T$ `! G( C, ~' ^3 M7 s0 N
27. longstatus = part.SaveAs3(pathstr2, 0, 0)
    3 N) I+ |( [# S* r5 q
28. 
    ; ~, W0 Z2 ]" G1 M
29. swapp.CloseDoc pathstr0
    
30. 
    
31. Next i
    % S- u' p; g  B
32. 
    + z7 l+ n/ S' \& {# R
33. End Sub
    
34. 
    . A$ I5 V' [, A2 E  Z
35. Private Sub Showfilelist(folderspec As String)
    9 J/ }5 i! ?+ P! J
36. Dim fs, f, f1, fc, s
    % ]. j  O* f3 ?# z
37. 
    
38. Set fs = CreateObject("Scripting.filesystemobject")
    
39. 
    
40. Set f = fs.getfolder(folderspec)
    
41. 
    
42. Set fc = f.files
    % H! \$ f7 r( h4 @) f8 r# s$ o. t
43. 
    * P( w( }$ W6 }- H. f. l
44. fnum = 0
    3 S6 q( B* |; |* j
45. 
    7 K3 u5 D$ P2 y) P) m; B
46. For Each f1 In fc
    
47. If InStr(UCase(f1.Name), "SLDDRW") > 0 Then
    2 b7 h" t9 w& x( t( p8 ]2 [8 h- J
48. fname(fnum) = f1.Name
    ) P( i. X, X0 q3 x- t. O& r6 C- Q
49. fnum = fnum + 1
    1 j- x2 T: ^& Z
50. 
    
51. End If
    : \; L9 T: w2 f  z
52. 
    
53. Next
    
54. 
    ! J: e( B5 {: e6 c  c& `
55. End Sub
    

复制代码

6 T2 M6 ^, Y$ c5 ]
1 j. o2 u- {9 t  [6 x9 Z) a" v2 y2 f0 ~

steve_suich

. w7 ]! l5 z% \! I3 _
! J( v7 m7 q% G+ H' A$ b8 u9 Fswapp.colsedoc 应为swapp.closedoc
) n$ l$ z8 r# Z6 EScripting,filesystemobject应为Scripting.filesystemobject
判断slddrw时，应先全部转换为大写，再进行判断。

dajian1984

steve_suich 发表于 2023-4-25 09:07
' a( s3 ^9 _, X& rswapp.colsedoc 应为swapp.closedoc
! x1 Z# y. D% _! E* K$ y% xScripting,filesystemobject应为Scripting.filesystemobject
判断sld ...

+ \7 F/ ^0 @8 x, N  v8 j' _  M: ?5 w谢谢。