|
|
本帖最后由 chenjj007 于 2024-1-27 15:29 编辑
这是SolidWorks批量将工程图转PDF的代码，运行过程中报错
——————————————————————————————————
下面是代码
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 PathStrO() 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
PathStrO = PathStr & "\" & FName(i)
Set Part = swApp.OpenDoc6(PathStr0, 3, 0, "", longstatus, longwarnings)
L = Len(PathStr0)
PathStr1 = Left(PathStr0, L - 7) & ".DWG"
PathStr2 = Left(PathStrO, 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)
Dimfs , 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
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-1-27 08:59
楼主
