|
程序设计时只加载了SolidWorks2016的库文件,没有加载SolidWorks2018的所以会出现问题,给你原始宏代码,自己编制一个吧!
- Dim swApp As Object
- Dim Part As Object
- Dim boolstatus As Boolean
- Dim longstatus As Long, longwarnings As Long
- Dim PathStr As String
- Dim FName(500) As String, FNum As Long
- Sub main()
- Dim i As Long
- Dim PathStr0 As String, PathStr1 As String
- Dim PathStr2 As String, PathStr3 As String, PathStr4 As String, PahtStr5 As String
- Dim L As Long, L1 As Long
- PathStr = InputBox("请输入需要转的工程图所在文件夹的完整路径")
- Call Showfilelist(PathStr)
- Set swApp = Application.SldWorks
- For i = 0 To FNum - 1
- PathStr0 = PathStr & "\" & FName(i)
- Set Part = swApp.OpenDoc6(PathStr0, 3, 0, "", longstatus, longwarnings)
- L = Len(PathStr0)
- PathStr1 = Left(PathStr0, L - 7) & ".DWG"
- PathStr2 = Left(PathStr0, L - 7) & ".PDF"
- longstatus = Part.SaveAs3(PathStr1, 0, 0)
- longstatus = Part.SaveAs3(PathStr2, 0, 0)
-
- Set Part = Nothing
- L1 = Len(FName(i))
- PathStr3 = Left(FName(i), L1 - 7) & " - 图纸1"
- PathStr4 = Left(FName(i), L1 - 7) & " - 图纸2"
- PathStr5 = Left(FName(i), L1 - 7) & " - 图纸3"
- swApp.CloseDoc PathStr3
- swApp.CloseDoc PathStr4
- swApp.CloseDoc PathStr5
- Next i
- End Sub
- Private Sub Showfilelist(folderspec As String)
- Dim fs, f, f1, fc, s
- Set fs = CreateObject("Scripting.FileSystemObject")
- Set f = fs.GetFolder(folderspec)
- Set fc = f.Files
- FNum = 0 '清零
- For Each f1 In fc
- If InStr(f1.Name, "SLDDRW") > 0 Then
- FName(FNum) = f1.Name
- FNum = FNum + 1
- End If
- Next
- end sub
复制代码 |
|