SOLIDWORKS Task Schedular我试了，根本动不了，自己也倒腾了个宏，功能是工程图转换成PDF和DWG文件，操作是，工具---》宏----》新建----》把下面的代码复制进去----》存到硬盘某个位置----》，调用的时候是，工具----》宏---》运行，当然也可以自定义到SW的工具栏上，宏文件源代码如下需要的拿去，：
# h) S/ l, w. H+ C, vDim swApp As Object
' W5 p" ]( v8 q! _: c4 TDim Part As Object' A h" q# [" E3 k
Dim boolstatus As Boolean) _) b- l8 }- R$ D
Dim longstatus As Long, longwarnings As Long
( v! y" F; O0 k$ h& F! k* r6 VDim PathStr As String
3 V' ?# Y; {6 n; L* jDim FName(500) As String, FNum As Long
/ R9 @. R) n9 Y1 X
1 H, P' M: `; O' i: C! kSub main(). g( c0 x% n1 W! _9 t6 o
Dim i As Long
, `$ k4 k1 A1 R, ^1 P z- wDim PathStr0 As String, PathStr1 As String
7 t' G% l8 P) R! ?! BDim PathStr2 As String, PathStr3 As String, PathStr4 As String, PahtStr5 As String
- `5 @. j! q! B7 G, n( S, J1 QDim L As Long, L1 As Long
}2 A( \. L1 ?# ~. jPathStr = InputBox("请输入需要转的工程图所在位置")3 c# H8 P7 T) w1 m6 E: P% D1 Y. @
Call Showfilelist(PathStr)
! k& @" B( e/ _, i& bSet swApp = Application.SldWorks# h5 }/ F* f) j
3 p! a, h) k) K, O
For i = 0 To FNum - 1( ?/ G) {1 o2 y9 i
PathStr0 = PathStr & "\" & FName(i). t0 A, V. `7 p
Set Part = swApp.OpenDoc6(PathStr0, 3, 0, "", longstatus, longwarnings)
& Y: j: j. f# M/ U6 I L = Len(PathStr0)3 v& T# w2 I4 e3 U# ~# T/ E
PathStr1 = Left(PathStr0, L - 7) & ".DWG"
/ A% h2 f3 V( E( X PathStr2 = Left(PathStr0, L - 7) & ".PDF"
: {$ a3 H- \" D* S. D* K& @ longstatus = Part.SaveAs3(PathStr1, 0, 0)# r0 ?0 M r1 ^: k' ]
longstatus = Part.SaveAs3(PathStr2, 0, 0)
# k/ |7 g6 e, Z2 z4 @1 h) p
" Z! J; M8 c: u1 U9 Q Set Part = Nothing8 S$ E5 f: e% |$ R+ z
+ d3 @; _& }4 D9 {" \' P
L1 = Len(FName(i)): ~6 t. o6 i# U. t Z2 M0 E2 X
PathStr3 = Left(FName(i), L1 - 7) & " - 图纸1"
) O7 U& F* b5 r2 H% Y PathStr4 = Left(FName(i), L1 - 7) & " - 图纸2". n, V2 y1 ^4 U" o& P. K- B
PathStr5 = Left(FName(i), L1 - 7) & " - 图纸3"6 \4 O, A* |: c. d8 L
$ I$ B3 U2 ?0 M- o swApp.CloseDoc PathStr3
/ z1 i) M2 i- v v2 c; H4 c swApp.CloseDoc PathStr4
! Y, i% b5 j! w6 j) _! D6 d1 C swApp.CloseDoc PathStr5
+ m% C: p; d7 W: e0 o, j7 X R# d* c. Y6 H9 f+ F
Next i; G: |' W" c) k( W* _! [ @
& B; n% T% K, r& N$ L
End Sub% y8 h8 G. E- Z2 `
3 O! t* _4 K5 @2 g6 Y2 G1 O) p3 R
Private Sub Showfilelist(folderspec As String)
. c! _9 |0 m3 p7 O Dim fs, f, f1, fc, s
) O1 G, O4 J& A$ q Set fs = CreateObject("Scripting.FileSystemObject")
1 S; [' q& B4 V6 o N. |0 \ Set f = fs.GetFolder(folderspec)
3 F* Q5 C. m0 y" c; t Set fc = f.Files
% @3 ]: g8 C' v( f FNum = 0 '清零
# F! s$ _8 F) H, F: g3 B For Each f1 In fc( G* p% D3 p3 l1 e0 l. v. B' ]. u
If InStr(f1.Name, "SLDDRW") > 0 Then% R0 \% v$ H x& Q: e
FName(FNum) = f1.Name l6 L, u! V9 @5 t' x( F4 e$ U) \4 d
FNum = FNum + 1
+ L& L& \+ r: ]6 Y) A/ s y$ W/ @1 q End If* b0 q8 q8 Q1 a; D; ? \
Next
" A0 h8 d! }, V0 }% P9 Y1 FEnd Sub
( c- ]$ _6 E, r. Q" u# v" I/ z |
发表于 2020-10-25 11:36:01
，有使用过的可以反馈一下。目前版本有更新。
# z9 l, B+ } P L, ?7 o' V- s
