solidworks的VBA问题

dajian1984

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

% v7 ^: S2 w; p( w+ wDim swapp As Object
Dim part As Object
" S0 G7 \8 D. ?Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
# a, i4 e( O4 s: m4 h$ g, T, _9 w* ODim pathstr As String
7 _3 W8 I3 |* X6 k2 E+ L& bDim fname(500) As String, fnum As Long
4 k& u+ B( A: J) f# k5 CSub main()
6 M" D9 T, J( z  X& b$ Q4 N$ ]Dim i As Long
$ H: R1 W2 q( Q* y2 WDim pathstr0 As String, pathstr1 As String
5 Y4 G5 A; v7 S% _4 ADim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
  R- V; V/ f' ^3 v9 L: hDim L As Long, L1 As Long
pathstr = InputBox("请输入需要转的工程图所在位置")
! \  I2 o2 v  Z. U1 V* rCall Showfilelist(pathstr)
0 y# Q' x1 T1 Z) |: _Set swapp = Application.SldWorks
! A9 W7 @' d3 y! {) y& ~
- k9 x+ `* ]- @, {+ S% b" ^For i = 0 To fnum - 1
pathstr0 = pathstr & "\" & fname(i)

Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
# s" w, R/ V0 ^5 P6 h2 R. B3 `
L = Len(pathstr0)
: ?$ [1 }1 Y. O# m
pathstr1 = Left(pathstr0, L - 7) & ".DWG"
8 }. O; N6 B! \" R; E1 Z# q
pathstr2 = Left(pathstr0, L - 7) & ".PDF"
1 Y' i* p+ m; Q7 y" `% E0 D
1 C. ?8 u* M2 p* e! B( @: C6 y: blongstatus = part.SaveAs3(pathstr1, 0, 0)
( a9 F) {1 y' c! [) l, m2 \/ }$ a
longstatus = part.SaveAs3(pathstr2, 0, 0)

Set part = Nothing
7 h) q6 g( I* y1 K# v) E" f
; K1 d5 K5 D, Y* I1 z. t% iL1 = Len(fname(i))

& N6 |2 S6 v* e0 g" bpathstr3 = Left(fname(i), L1 - 7) & "- 图纸1"
$ t0 n( J( I! e
pathstr4 = Left(fname(i), L1 - 7) & "- 图纸2"
) L6 K  D( K8 T) I: Q
pathstr5 = Left(fname(i), L1 - 7) & "- 图纸3"

swapp.colsedoc pathstr3
! h* f# \! a" A& s3 S8 G# `
swapp.colsedoc pathstr4

" K' f3 N7 i! k* K$ B& Z7 cswapp.colsedoc pathstr5
8 y* ~. [: T* D# r& F; \* P
* |% V. }4 I- n' }" n# Z2 s; s! @Next i
( o7 `) k8 w) D2 I# f! j

End Sub


Private Sub Showfilelist(folderspec As String)

* f  A4 V3 v- \  V7 m7 @
) \6 P, y% E. _! |Dim fs, f, f1, fc, s

1 U+ ]$ c9 D, a7 Q4 b. R) tSet fs = CreateObject("scripting,filesystemobject")
8 }4 d9 v8 {0 B5 j/ K
: W( W4 s( z8 B! U8 w+ |Set f = fs.getfolder(folderspec)
+ A, H1 V5 B+ w$ V) i
( U7 V0 z4 R- i) m( B; vSet fc = f.files
1 M' M4 G3 f, G% U# \/ v
fnum = 0

8 p9 _% d8 k3 q# o5 K7 rFor Each fi In fc
5 c% ?2 h1 `! V# c
If InStr(f1.Name, "slddrw") > 0 Then

/ R( b8 ?6 _' [, U+ j8 U& Z4 Wfname(fnum) = f1.Name

% O  b& K, i6 l  ]4 M  B% Mfnum = fnum + 1

End If
& ~0 P. Y: w$ |9 c- Z
& |. Y" d; V" Q' ]$ m1 I7 CNext

End Sub
/ W& K9 O% x3 H) z& |
' k! n% Z2 S- S4 A& \

dajian1984

steve_suich 发表于 2023-4-25 09:07
swapp.colsedoc 应为swapp.closedoc
7 q* V7 V3 x* l& G4 X  D: ~Scripting,filesystemobject应为Scripting.filesystemobject
判断sld ...

谢谢。
6 a( |  H$ `* V

steve_suich

swapp.colsedoc 应为swapp.closedoc
! S( x9 G  o; N. X+ D2 c2 pScripting,filesystemobject应为Scripting.filesystemobject
判断slddrw时，应先全部转换为大写，再进行判断。

steve_suich

1. Dim swapp As Object
   8 Z) ^' ^' R) V/ f
2. Dim part As Object
   
3. Dim boolstatus As Boolean
   
4. Dim longstatus As Long, longwarnings As Long
   
5. Dim pathstr As String
   : c0 S) ^# M" s# G
6. Dim fname(500) As String, fnum As Long
   ; U* @) s2 ]/ y
7. Sub main()
   2 y6 {& m# P4 S4 A0 m
8. Dim i As Long
   - ?! \4 ?. `4 B- c6 _5 J/ Z
9. Dim pathstr0 As String, pathstr1 As String
   
10. Dim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
    " Z7 C8 s# k( o. J
11. Dim L As Long, L1 As Long
    # V; W; C: D" x  A: O1 o
12. pathstr = InputBox("请输入需要转换的工程图所在位置")
    
13. Call Showfilelist(pathstr)
    ( V9 w$ ?* {4 y/ E4 x7 b# u
14. Set swapp = Application.SldWorks
    & j. H% [8 }$ @% ~% c; p
15. 
    
16. For i = 0 To fnum - 1
    - e' B( X4 K3 [* ]; k
17. pathstr0 = pathstr & "" & fname(i)
    
18. 
    . i& h8 }3 K9 ?
19. Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
    5 a7 Y# |, O5 a6 S+ k& ?
20. L = Len(pathstr0)
    ) ^% [1 O. K, E$ R; _) I
21. 
    ; R/ ^9 e; [+ `+ J
22. pathstr1 = Left(pathstr0, L - 7) & ".DWG"
    
23. 
    . V' d# U5 y- J% k) A0 t6 }8 b+ Y
24. pathstr2 = Left(pathstr0, L - 7) & ".PDF"
    
25. 
    ( }2 J" M$ T# E. G# _0 D8 V
26. longstatus = part.SaveAs3(pathstr1, 0, 0)
    & Y; u; K; _. Z9 V5 H3 N
27. longstatus = part.SaveAs3(pathstr2, 0, 0)
    
28. 
    
29. swapp.CloseDoc pathstr0
    6 J0 y- J9 R$ f- Z4 q0 @7 J, c
30. 
    ! f5 @0 f! N$ r: [6 |1 O
31. Next i
    . e, g# y; A' [5 Q% s/ k  V
32. 
    7 x/ `6 i9 w3 [3 w- u$ b: o
33. End Sub
    
34. 
    + V0 S* z  d- N
35. Private Sub Showfilelist(folderspec As String)
    6 @, K# ]0 B$ X6 n- w
36. Dim fs, f, f1, fc, s
    
37. 
    
38. Set fs = CreateObject("Scripting.filesystemobject")
    , ~# Z1 e& j) o( M# \) k. h! m; X
39. 
    3 X4 |+ M, U* i; @5 e
40. Set f = fs.getfolder(folderspec)
    ' k- v3 v& `$ H, J2 F  I
41. 
    * [4 p0 o1 r$ g4 @5 N( ]
42. Set fc = f.files
    
43. 
    
44. fnum = 0
    ' r2 h' e8 O) m
45. 
    
46. For Each f1 In fc
    * }" h. P& f  b* L" [
47. If InStr(UCase(f1.Name), "SLDDRW") > 0 Then
    ' w5 ], h2 f: w! c2 S
48. fname(fnum) = f1.Name
    
49. fnum = fnum + 1
    + {; e6 b  a% D! e/ }1 [8 [3 W
50. 
    9 [& j  k) E% v& j0 M
51. End If
    
52. 
    
53. Next
    
54. 
    ' ]& i$ h( ]+ b6 F2 J: K) U
55. End Sub
    

复制代码

6 R$ X; x  h( _! F, h, A