solidworks的VBA問題

dajian1984

我打的程序無法運行，有沒有懂的人幫我看看！謝謝。
5 S- P3 E8 c, m' y% h* A
6 [% U9 O5 Z# S0 NDim swapp As Object
5 L8 j; m- L  k- uDim part As Object
1 x, c# S3 X* E/ i+ U: eDim boolstatus As Boolean
. Q* O5 W1 ^0 t% G" C" DDim longstatus As Long, longwarnings As Long
* p: F9 J% u4 w, W3 g+ @6 x2 uDim pathstr As String
& H3 }- T% V1 a+ e/ R- Y( B$ B; I5 X, BDim fname(500) As String, fnum As Long
1 h5 D! Q& v$ x; V' RSub main()
+ z4 m) |$ v! SDim i As Long
Dim pathstr0 As String, pathstr1 As String
Dim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
! G  M) M1 o, q5 RDim L As Long, L1 As Long
& n$ L1 j; G- ]+ o& f. a  [. U6 }2 cpathstr = InputBox("請輸入需要轉(zhuǎn)的工程圖所在位置")
Call Showfilelist(pathstr)
Set swapp = Application.SldWorks
, ^% z. @) u; e$ g
For i = 0 To fnum - 1
/ D) Z: x* e0 lpathstr0 = pathstr & "\" & fname(i)

& \) n2 F1 u+ M- E% |Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
) y- S0 d9 y) ?1 ~
L = Len(pathstr0)
" Q# |& r, J' n0 P9 S
pathstr1 = Left(pathstr0, L - 7) & ".DWG"
) {7 a2 ?* g: S8 I4 x. ~4 B- O
pathstr2 = Left(pathstr0, L - 7) & ".PDF"

longstatus = part.SaveAs3(pathstr1, 0, 0)
: V7 E! F6 e7 c1 g
longstatus = part.SaveAs3(pathstr2, 0, 0)

4 ?" w# r/ d+ W2 x7 XSet part = Nothing

L1 = Len(fname(i))
) c9 S8 Y9 ~  z# Q9 R
+ }. \- ~. G  _# S8 k' K0 `pathstr3 = Left(fname(i), L1 - 7) & "- 圖紙1"
3 n- J: D" ~  {  v2 |
0 {$ C6 y! l8 r. Tpathstr4 = Left(fname(i), L1 - 7) & "- 圖紙2"

pathstr5 = Left(fname(i), L1 - 7) & "- 圖紙3"

swapp.colsedoc pathstr3
* V" a2 ~* X" z8 g% N0 G
swapp.colsedoc pathstr4
" g5 Q* |8 H' L; o3 ]0 B3 `+ H: Z
swapp.colsedoc pathstr5
* u- T1 F( I! r1 y1 V
: H/ E1 Z6 u( |$ F" _, Z1 VNext i


+ R$ R* n0 _  z3 Y5 J9 D: ]End Sub
1 [6 [- R  Y- _

Private Sub Showfilelist(folderspec As String)


# ]" [  K+ R2 B" O6 J/ EDim fs, f, f1, fc, s

$ L1 `) q1 k+ p& iSet fs = CreateObject("scripting,filesystemobject")

Set f = fs.getfolder(folderspec)

0 ?$ U) y8 R7 z) tSet fc = f.files
5 T. ?$ m0 K% q  c0 e
fnum = 0
4 j; B4 _! T/ u' F
( u7 W9 @! O) r8 ], U: |For Each fi In fc
! X9 t, j. X1 t6 z
1 w9 D# w- i. `$ |3 K# B  F: kIf InStr(f1.Name, "slddrw") > 0 Then

fname(fnum) = f1.Name

7 j) }8 @/ S1 F- f1 ]3 Kfnum = fnum + 1

End If
9 N6 s& b( Z5 \6 N. ^# u/ |& N
0 k( n  c! J1 ^: JNext

7 h7 v: A0 T" S$ W' e6 `0 [End Sub

steve_suich

1. Dim swapp As Object
   
2. Dim part As Object
   + L& O0 Q2 ^. A) r& O! ^* W2 B) `
3. Dim boolstatus As Boolean
   5 W7 q' ?) j) I' b
4. Dim longstatus As Long, longwarnings As Long
   
5. Dim pathstr As String
   6 i% L, q) n, U- h" P
6. Dim fname(500) As String, fnum As Long
   
7. Sub main()
   
8. Dim i As Long
   . X$ C2 s1 j* S- j
9. Dim pathstr0 As String, pathstr1 As String
   
10. Dim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
    : ]& M3 r) Q2 g
11. Dim L As Long, L1 As Long
    
12. pathstr = InputBox("請輸入需要轉(zhuǎn)換的工程圖所在位置")
    % `' k5 c4 W: F3 s0 @$ ^
13. Call Showfilelist(pathstr)
    # v8 a# b0 @1 s  _
14. Set swapp = Application.SldWorks
    
15. 
    . d8 s( C  ^9 W& D' S
16. For i = 0 To fnum - 1
    
17. pathstr0 = pathstr & "" & fname(i)
    
18. 
    ! t3 v) ^- G3 p. b
19. Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
    
20. L = Len(pathstr0)
    - j0 p# q% y7 d& S  ^# g$ r
21. 
    - d* ?) k: v. d# r& p) g, u
22. pathstr1 = Left(pathstr0, L - 7) & ".DWG"
    7 Y$ O# r4 z9 V  i& \! J. o  ~- f
23. 
    
24. pathstr2 = Left(pathstr0, L - 7) & ".PDF"
    ; {, |7 k. {3 F9 u
25. 
    * r; M" S0 J, W4 H# |
26. longstatus = part.SaveAs3(pathstr1, 0, 0)
    + r) r" X7 {9 m4 l
27. longstatus = part.SaveAs3(pathstr2, 0, 0)
    
28. 
    ' A; d) l8 L5 h$ B: Q( L/ z4 E
29. swapp.CloseDoc pathstr0
    ' i) u) [9 K) l* H" f( K
30. 
    
31. Next i
    
32. 
    
33. End Sub
    
34. 
    
35. Private Sub Showfilelist(folderspec As String)
    + f5 P) n4 J, Y
36. Dim fs, f, f1, fc, s
    
37. 
    ( _: t! [2 Z' l$ b" T$ K" M  G
38. Set fs = CreateObject("Scripting.filesystemobject")
    # ]* g, B6 {4 Q! a/ S; {$ z
39. 
    
40. Set f = fs.getfolder(folderspec)
    
41. 
    ; w- l0 F/ d# G) u: y* T6 M
42. Set fc = f.files
      D3 i' a& B8 s9 N8 R
43. 
    
44. fnum = 0
    1 j1 o; \4 J, r( h9 ]
45. 
    
46. For Each f1 In fc
    
47. If InStr(UCase(f1.Name), "SLDDRW") > 0 Then
    
48. fname(fnum) = f1.Name
    
49. fnum = fnum + 1
    ' |% J- w4 R2 X6 q3 ^" A
50. 
    
51. End If
    
52. 
    
53. Next
    
54. 
    
55. End Sub
    " r, ]9 m# ]& |, j8 U$ b: L

復制代碼

steve_suich

+ q7 d  S6 u+ {9 t5 H
swapp.colsedoc 應(yīng)為swapp.closedoc
Scripting,filesystemobject應(yīng)為Scripting.filesystemobject
8 C6 s9 O3 r, r9 d% O8 {+ i8 T判斷slddrw時，應(yīng)先全部轉(zhuǎn)換為大寫，再進行判斷。

dajian1984

steve_suich 發(fā)表于 2023-4-25 09:07
swapp.colsedoc 應(yīng)為swapp.closedoc
Scripting,filesystemobject應(yīng)為Scripting.filesystemobject
判斷sld ...

7 D1 Z, p" S$ P* {8 T2 d謝謝。
5 {: @- }4 M$ P/ j& i