|
|
- Option Explicit
- Sub main()
- Dim swApp As SldWorks.SldWorks
- Dim swModel As SldWorks.ModelDoc2
- Dim swDrawing As SldWorks.DrawingDoc
- Dim swSheet As SldWorks.Sheet
- Dim sheetCount As Integer
- Dim i As Integer
- Dim outputPath As String
-
- outputPath = "F:\桌面\试验品\新建文件夹\" '请修改为您的输出路径
-
- Set swApp = Application.SldWorks
- Set swModel = swApp.ActiveDoc
-
- If swModel Is Nothing Then
- MsgBox "请打开一个工程图文档。"
- Exit Sub
- End If
-
- If swModel.GetType <> swDocumentTypes_e.swDocDRAWING Then
- MsgBox "当前文档不是工程图。"
- Exit Sub
- End If
-
- Set swDrawing = swModel
- sheetCount = swDrawing.GetSheetCount
-
- For i = 0 To sheetCount - 1
- Set swSheet = swDrawing.Sheet(swDrawing.GetSheetNames()(i))
- swDrawing.ActivateSheet swSheet.GetName
-
- '保存单页工程图
- swModel.Extension.SaveAs _
- outputPath & swSheet.GetName & ".slddrw", _
- swSaveAsVersion_e.swSaveAsCurrentVersion, _
- swSaveAsOptions_e.swSaveAsOptions_Silent, _
- Nothing, 0, 0
- Next i
-
- MsgBox "工程图已成功拆分为单页。"
- End Sub
|
|
[复制链接]
楼主
QQ好友和群
QQ空间
腾讯微博
腾讯朋友
收藏
转播
教程|习题|模型|技巧
点赞
拍砖
发表于 2023-7-10 10:04:25
鲁公网安备 37028502190335号