SOLIDWORKS Task Schedular我试了，根本动不了，自己也倒腾了个宏，功能是工程图转换成PDF和DWG文件，操作是，工具---》宏----》新建----》把下面的代码复制进去----》存到硬盘某个位置----》，调用的时候是，工具----》宏---》运行，当然也可以自定义到SW的工具栏上，宏文件源代码如下需要的拿去，：
1 ~( G! T8 J* s) W) ?Dim swApp As Object% ^' A9 B, ~% q1 d* Z0 A: \
Dim Part As Object, s0 ^6 W/ b3 s4 P" r/ o0 ~' Y! y/ Z" ^
Dim boolstatus As Boolean
$ ?; V. M: K3 M) kDim longstatus As Long, longwarnings As Long
( W- N, K7 S7 ~4 X) u5 qDim PathStr As String+ B/ K9 Q) Z( I
Dim FName(500) As String, FNum As Long
6 j5 e8 i* D1 x3 E5 i/ [8 J& `+ t& u8 F" {1 s3 ]
Sub main()
6 ^$ |: V% r( J* c4 dDim i As Long* p# Z* M* ]; Z: J7 S' n
Dim PathStr0 As String, PathStr1 As String
1 t/ w" w# V3 w9 ^( JDim PathStr2 As String, PathStr3 As String, PathStr4 As String, PahtStr5 As String2 R& x$ \ n- Z
Dim L As Long, L1 As Long' u( ~7 k6 a/ m: ^3 |- u
PathStr = InputBox("请输入需要转的工程图所在位置")
! ?1 }9 z2 X) ^1 A4 r! nCall Showfilelist(PathStr)
2 U' H1 _8 |# y% ]# B0 W( K' kSet swApp = Application.SldWorks
9 D+ r' j E0 B$ E4 E) j9 N
8 V4 G- B4 q( k1 E& JFor i = 0 To FNum - 1
5 E( ] u- b- k, j. J PathStr0 = PathStr & "\" & FName(i)6 E: p: A1 d# {3 e* F* x
Set Part = swApp.OpenDoc6(PathStr0, 3, 0, "", longstatus, longwarnings)
4 Y( t- ~7 ^3 }' r L = Len(PathStr0)9 r2 }# Z! W; c0 Z# {
PathStr1 = Left(PathStr0, L - 7) & ".DWG"; ^& \3 K" b2 C6 ?0 Q4 g' C) v
PathStr2 = Left(PathStr0, L - 7) & ".PDF"
n/ B- t5 P" ^8 L' g6 T longstatus = Part.SaveAs3(PathStr1, 0, 0)
/ A3 y- F$ R' g3 ?; ~ \& @! W longstatus = Part.SaveAs3(PathStr2, 0, 0), A0 e$ F% F' B
$ E8 A( ?' Y+ w& e
Set Part = Nothing
# B8 Z0 Z+ \2 n# ~2 J2 {/ f& `; \
6 Y' }0 f% v+ {2 _2 ^ L1 = Len(FName(i))
+ J2 ]# S$ Q/ O% y' y! z PathStr3 = Left(FName(i), L1 - 7) & " - 图纸1"
4 O r# M) i! A, I) B3 q* R8 v PathStr4 = Left(FName(i), L1 - 7) & " - 图纸2"
" ^* @& G7 }- e% |3 W, u PathStr5 = Left(FName(i), L1 - 7) & " - 图纸3"- P; Y8 J! e, T
R. ?, ?1 W) f; p; t
swApp.CloseDoc PathStr3" x( r% _" h& b1 J+ @7 h7 ~
swApp.CloseDoc PathStr4* A0 e: K" J+ [% X2 p
swApp.CloseDoc PathStr52 @6 o& r! u$ x) S7 v2 u* J5 F: t, B
?9 d6 Y1 c" l; y
Next i$ z4 `, s5 n# F0 k; l8 a8 a
% }$ a, E( ^% |& {, w
End Sub& Z/ D/ K4 `7 ^9 w7 j; N+ d3 r
5 @2 n& B) u0 A5 k2 WPrivate Sub Showfilelist(folderspec As String); V; X+ ]2 S& T/ D- H
Dim fs, f, f1, fc, s3 p: j: ]) b' Q9 ? c+ b
Set fs = CreateObject("Scripting.FileSystemObject")5 e H p7 e) ~
Set f = fs.GetFolder(folderspec)( T. H! W6 O! |- A" i
Set fc = f.Files
1 a# {! ]2 X0 a% M( ]0 _4 U1 h FNum = 0 '清零8 p1 K9 U3 ]2 Q. A6 w5 R" D3 @
For Each f1 In fc
@1 g# U! W* K$ ]1 M/ j If InStr(f1.Name, "SLDDRW") > 0 Then! Y1 y" R/ e q' x
FName(FNum) = f1.Name
i$ [) J8 m h! D# \" E FNum = FNum + 1
( m: R+ y2 s: _8 j/ t1 l/ @ End If
' Q2 g. Y* y# Z3 j, L, w' D Next N8 n3 v2 s' r' m
End Sub0 m0 r7 b- b+ T2 v/ b
|
发表于 2020-10-25 11:36:01
楼主
，有使用过的可以反馈一下。目前版本有更新。
4 B8 x6 ^ l; @2 c4 ]0 p4 h
