|
加入QQ群
参与讨论和学习
或扫描二维码加入
我研究了你说的那个宏,没有遍历装配体宏的功能吧!- Option Explicit
- Dim swApp As SldWorks.SldWorks
- Dim swModel As SldWorks.ModelDoc2
- Dim swDraw As SldWorks.DrawingDoc
- Dim swExport As Variant
- Dim swPath As String
- Dim swName As String
- Dim swSheetName As String
- Dim dirName As String
- Dim i As Integer
- Dim numshts As Long
- Dim lErrors As Long
- Dim lWarnings As Long
- Sub main()
- Set swApp = Application.SldWorks
- Set swModel = swApp.ActiveDoc
-
- On Error Resume Next
- If swModel.GetType = 3 Then
- Set swDraw = swModel
- swPath = swDraw.GetPathName
- swName = Mid(swPath, InStrRev(swPath, "\") + 1, Len(swPath) - InStrRev(swPath, "\") - 7)
- swPath = Mid(swPath, 1, InStrRev(swPath, "\") - 1)
- ChDrive Left(swPath, 3)
- ChDir (swPath)
- dirName = "PDF"
- If Dir(dirName, vbDirectory) = "" Then MkDir (dirName)
- ChDir (dirName)
-
- numshts = swDraw.GetSheetCount
- For i = 1 To numshts
- swDraw.SheetPrevious
- Next i
-
- For i = 1 To numshts
- swSheetName = swDraw.GetCurrentSheet.GetName
- Set swExport = swApp.GetExportFileData(1)
- swExport.SetSheets (2)
- swDraw.Extension.SaveAs swName & "-" & swSheetName & ".pdf", 0, 0, swExport, lErrors, lWarnings
- swDraw.SheetNext
- Next i
- Else
- MsgBox "当前文档不是工程图,无法进行操作!"
- End If
-
- End Sub
复制代码 |
|