如何批量导出钣金件展开图

liuzhanping9605 · 发表于 2014-9-17 13:51:26

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

一般要将钣金件展开图拷过数控编程，一个个另存效率很低，不知有没有批量方法？

下面方法可另存pdf，却不能另存dxf
Private Sub cmdExportDxf_Click()
Dim f As File
Dim fo As Folder
Dim sName As String
Dim sExNameForOut As String
Dim sExNameForIn As String

sExNameForIn = "SLDPRT"
sExNameForOut = "dxf"

Set fo = fso.GetFolder(txtDir)

If Not fso.FolderExists(fo) Then
   MsgBox "目录不存在！"
   Exit Sub
End If

Dim retVal As Boolean
For Each f In fo.Files
   Dim sSaveName As String
   Dim longstatus As Long
   Dim longwarnings As Long

   If fso.GetExtensionName(f) = sExNameForIn Then
      If Not Left(fso.GetBaseName(f), 2) = "~$" Then
'          Set part = swApp.ActiveDoc
         Set part = swApp.OpenDoc6(f, 1, 0, "", longstatus, longwarnings)
         If IsSheet(part) = True Then
            sSaveName = fso.GetParentFolderName(f) & "\" & fso.GetBaseName(f) & "." & sExNameForOut
            retVal = part.SaveAs3(sSaveName, 0, 0)
'             retVal = part.SaveAs4(sSaveName, 0, 0, 0, 0)

         End If
      End If
   End If
'    part.Close
      swApp.CloseDoc (f)
Next
End Sub

liuzhanping9605 · 发表于 2014-9-17 16:40:13

没有人知道吗？

liuzhanping9605 · 发表于 2014-9-18 12:26:51

看来还是得靠自己

liuzhanping9605 · 发表于 2014-9-19 12:07:48

自己看SDK搞定，分享一下

'************************************************************
'函数名：
'功能：导出当前钣金件为dxf
Private Sub cmdExportDxfForCurrent_Click()
Dim partDoc As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim boolRetVal As Boolean
Dim sSaveName As String
Dim f As File
Dim path As String
Dim sExNameForOut As String
Dim sExNameForIn As String
Dim sSavePath As String

sExNameForIn = "SLDPRT"
sExNameForOut = "dxf"

Set partDoc = swApp.ActiveDoc
path = partDoc.GetPathName
Set f = fso.GetFile(path)

If Not partDoc Is Nothing Then
   If IsSheet(partDoc) Then
         sSavePath = fso.GetParentFolderName(f) & "\" & DXF_SAVE_DIR & "\"
         If Not fso.FolderExists(sSavePath) Then
            Call fso.CreateFolder(sSavePath)
         End If
         sSaveName = sSavePath & fso.GetBaseName(f) & "." & sExNameForOut

         Set swModelDocExt = partDoc.Extension
         boolRetVal = partDoc.ExportFlatPatternView(sSaveName, 0)
         Call swModelDocExt.SaveAs(sSaveName, 0, 0, Nothing, 0, 0)
   Else
         MsgBox ("当前文件不是钣金!")
         End
   End If
End If
End Sub

slzhrb · 发表于 2016-7-30 19:51:11

厉害！！！！

qiuli108028 · 发表于 2016-8-1 13:57:10

		自动登录	找回密码
密码			注册

通知

[求助] 如何批量导出钣金件展开图

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

浏览过的版块