solidworks的VBA問題

dajian1984

我打的程序無法運行,，有沒有懂的人幫我看看！謝謝,。

0 ~6 j9 q& G- J6 t8 PDim swapp As Object
8 E: g/ @  a) a' E- }8 Q) ADim part As Object
* x, K: |* j7 ]/ Q# o6 c- nDim boolstatus As Boolean
6 x9 ]) \0 x/ ?" o- mDim longstatus As Long, longwarnings As Long
Dim pathstr As String
! V" C, h0 {$ i0 B3 k# E$ z5 cDim fname(500) As String, fnum As Long
Sub main()
Dim i As Long
" ~0 e9 l1 c: H7 d4 P8 RDim pathstr0 As String, pathstr1 As String
+ d. Z6 ?3 ]% ]Dim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
9 ]& M" m" w$ ]3 }) F) QDim L As Long, L1 As Long
pathstr = InputBox("請輸入需要轉的工程圖所在位置")
) X: i% A) _( r+ y* mCall Showfilelist(pathstr)
Set swapp = Application.SldWorks

3 }$ s3 j2 N$ Z; H/ j+ Q' YFor i = 0 To fnum - 1
pathstr0 = pathstr & "\" & fname(i)

Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)

L = Len(pathstr0)

( e' H% R$ O1 W0 K5 B# Upathstr1 = Left(pathstr0, L - 7) & ".DWG"

4 X% d  [1 J7 }! wpathstr2 = Left(pathstr0, L - 7) & ".PDF"

" u+ D- y9 Q& U- K" Q' I6 Rlongstatus = part.SaveAs3(pathstr1, 0, 0)
3 x% u+ w5 o9 z
9 o( l  r0 ~. S2 p: Z1 ilongstatus = part.SaveAs3(pathstr2, 0, 0)
1 q8 Y5 N9 j, R0 e
Set part = Nothing
) K6 Y* e  t+ o' ~; R4 Z
L1 = Len(fname(i))

0 c- c. f* A! ^+ f5 J% vpathstr3 = Left(fname(i), L1 - 7) & "- 圖紙1"

pathstr4 = Left(fname(i), L1 - 7) & "- 圖紙2"

1 V' O3 s2 \, ]! P, hpathstr5 = Left(fname(i), L1 - 7) & "- 圖紙3"
+ I/ X0 w3 G$ x3 I5 {  E
swapp.colsedoc pathstr3

; T" q+ S5 Y9 T* e2 M% ]4 `swapp.colsedoc pathstr4

; p1 v8 y  B; C  n+ T+ jswapp.colsedoc pathstr5
1 c% d" s0 \# |* @7 Y
Next i
1 Q' |$ [. Q  h+ f& w

: ?& m$ x' M1 r  \7 s. }+ X9 `* T/ zEnd Sub
$ W6 I2 @8 U; F& w. y
# h7 ~7 x# b& z3 @  G
Private Sub Showfilelist(folderspec As String)


. n- }% Q0 I' {3 K4 a9 q7 ?; ODim fs, f, f1, fc, s

Set fs = CreateObject("scripting,filesystemobject")
5 J# ~1 Y4 G, I6 v
Set f = fs.getfolder(folderspec)
  z4 c+ B: g  g5 p0 D4 F: O% n: s
Set fc = f.files

fnum = 0
$ ?" Y! z, K$ V$ O5 q7 B' q
& J: O9 M  ]9 u3 s2 |For Each fi In fc

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

/ O% J1 \; K0 q! @7 E, ]7 G; Cfname(fnum) = f1.Name
0 @5 \; `. d3 \. ^
fnum = fnum + 1

5 w* H. ]' X! e! Q5 r! v/ E4 K5 v$ C% {End If
' a1 C. \! K- z2 R4 v; _& S
Next

2 g9 d8 m' C+ r, e* N) R+ PEnd Sub

, U; H7 V5 G- X$ X

steve_suich

1. Dim swapp As Object
   ! z5 O. i+ U9 Y
2. Dim part As Object
   
3. Dim boolstatus As Boolean
   . s% j6 J6 E+ [. V; Q4 s
4. Dim longstatus As Long, longwarnings As Long
   
5. Dim pathstr As String
   # I8 I, |  l9 S3 A, S6 D' s' ]- T
6. Dim fname(500) As String, fnum As Long
   
7. Sub main()
   
8. Dim i As Long
   
9. Dim pathstr0 As String, pathstr1 As String
   ! H  m8 ]$ @/ a3 @- j3 n' n
10. Dim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
    " t  r3 l4 {+ T9 p
11. Dim L As Long, L1 As Long
    ( P4 h1 @+ G7 j* ]. U6 |
12. pathstr = InputBox("請輸入需要轉換的工程圖所在位置")
    2 s8 y# P# T8 I
13. Call Showfilelist(pathstr)
    
14. Set swapp = Application.SldWorks
    ) z  e) U4 A4 q* H1 W6 G( \/ F
15. 
    
16. For i = 0 To fnum - 1
    
17. pathstr0 = pathstr & "" & fname(i)
    & Y3 A" b, k) }2 V0 l/ m+ n* A9 g
18. 
    : Q& g" h! t) m
19. Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
    
20. L = Len(pathstr0)
    
21. 
    3 x4 @  [# F8 R6 D. D; h
22. pathstr1 = Left(pathstr0, L - 7) & ".DWG"
    
23. 
    
24. pathstr2 = Left(pathstr0, L - 7) & ".PDF"
    2 @  Z' D4 w& A9 k
25. 
    
26. longstatus = part.SaveAs3(pathstr1, 0, 0)
    
27. longstatus = part.SaveAs3(pathstr2, 0, 0)
    " l) w" F  d0 U, l7 B0 }
28. 
    ( m. `4 e; [" J0 z1 I( D
29. swapp.CloseDoc pathstr0
    7 F* {2 k" Q% P! ~
30. 
    2 R+ d0 w& J6 e" j3 _
31. Next i
    
32. 
    
33. End Sub
    ; u: @* q8 \1 h; [  k. Q, j
34. 
    
35. Private Sub Showfilelist(folderspec As String)
    
36. Dim fs, f, f1, fc, s
    9 m  K) b+ }8 E! d! N( i# V: e
37. 
    4 m* D* K4 Y7 @( [2 t, i( U$ U
38. Set fs = CreateObject("Scripting.filesystemobject")
    3 B0 d% v9 q% ]1 N- f
39. 
    ! g8 H8 w2 |7 c6 b4 m5 [
40. Set f = fs.getfolder(folderspec)
    3 f) \: W; G* b' ^1 s" Y* d7 \
41. 
    
42. Set fc = f.files
    
43. 
    
44. fnum = 0
    , r- Z7 N2 p2 K9 {! ~
45. 
    
46. For Each f1 In fc
    + A1 ~# d7 c  r# e! r; h
47. If InStr(UCase(f1.Name), "SLDDRW") > 0 Then
    
48. fname(fnum) = f1.Name
    - ?1 R5 T* ], y& q6 f% B
49. fnum = fnum + 1
    ( V# n& f6 w' U. e
50. 
    0 T9 v, u0 Y% M# U8 p3 s" f/ n
51. End If
    
52. 
    / J9 z, x( |; K, i, q: y
53. Next
    
54. 
    ; ^: n9 Z' M: Q* N3 j
55. End Sub
    

復制代碼

7 D% D- o7 L) e: z$ u

steve_suich

0 i( I) k9 B# W; j) c5 J8 C8 f  B; @
: t( S( R, X$ S% {( Q! }swapp.colsedoc 應為swapp.closedoc
Scripting,filesystemobject應為Scripting.filesystemobject
判斷slddrw時,，應先全部轉換為大寫,，再進行判斷。

dajian1984

steve_suich 發(fā)表于 2023-4-25 09:07
6 E# V, Y, N) m" D, I5 l8 fswapp.colsedoc 應為swapp.closedoc
Scripting,filesystemobject應為Scripting.filesystemobject
# J3 D  l- d% _判斷sld ...

' A" x0 I4 J1 @+ A0 j# V謝謝,。