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

liuzhanping9605

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

2 o8 x% O  _3 J6 R5 ?; I) W; P下面方法可另存pdf，却不能另存dxf
& f4 ?) {! Y: p0 K7 lPrivate Sub cmdExportDxf_Click()
5 ^4 A7 g8 i5 [& N9 w4 d    Dim f As File
    Dim fo As Folder
. M) O: c& X0 @7 _, X1 N    Dim sName As String
    Dim sExNameForOut As String
    Dim sExNameForIn As String

+ C" a9 N$ Q4 ?/ c; ^( F+ Y% D: B    sExNameForIn = "SLDPRT"
    sExNameForOut = "dxf"

    Set fo = fso.GetFolder(txtDir)
6 z& M8 l" M5 c8 p3 @- m
! {+ |+ g$ o. N( i5 R    If Not fso.FolderExists(fo) Then
       MsgBox "目录不存在！"
       Exit Sub
    End If

    Dim retVal As Boolean
3 j- Z8 T0 n; O4 x. n  {    For Each f In fo.Files
       Dim sSaveName As String
       Dim longstatus As Long
       Dim longwarnings As Long

       If fso.GetExtensionName(f) = sExNameForIn Then
9 b/ C' y1 c8 D9 F1 I; i' z7 T          If Not Left(fso.GetBaseName(f), 2) = "~$" Then
) H( }% v: o5 x! k'             Set part = swApp.ActiveDoc
% d' {3 L" Y6 ^1 ^! f% G4 E( E             Set part = swApp.OpenDoc6(f, 1, 0, "", longstatus, longwarnings)
4 D" V2 x/ }0 F8 e             If IsSheet(part) = True Then
- e, y2 N* A6 b+ b$ O7 A8 k- v8 U                sSaveName = fso.GetParentFolderName(f) & "\" & fso.GetBaseName(f) & "." & sExNameForOut
$ H2 K% U) X7 s                retVal = part.SaveAs3(sSaveName, 0, 0)
/ V: E- v3 P* h2 z9 S$ s'                retVal = part.SaveAs4(sSaveName, 0, 0, 0, 0)

             End If
8 |8 a. e% N% V' k* `: T% Z          End If
       End If
'       part.Close
2 s3 w+ G1 Z, K5 B& x% w7 A& y        swApp.CloseDoc (f)
    Next
End Sub

" h; ^# w2 I( |6 K( ^

liuzhanping9605

没有人知道吗？

liuzhanping9605

看来还是得靠自己

liuzhanping9605

自己看SDK搞定，分享一下
; W/ j* J: B) _( `% {
'************************************************************
0 x/ q! G4 @- Y'函数名：
'功能：导出当前钣金件为dxf
, N  g2 p3 w0 CPrivate Sub cmdExportDxfForCurrent_Click()
) D+ c" T2 w3 G7 B' a    Dim partDoc As SldWorks.ModelDoc2
    Dim swModelDocExt As SldWorks.ModelDocExtension
' s0 g! j5 q" L$ [+ [, z    Dim boolRetVal As Boolean
/ [5 D8 Q/ [  }1 U8 b- E    Dim sSaveName As String
    Dim f As File
! s  \4 Y% `2 P- h- o    Dim path As String
( S- h& I* A2 i7 ?/ Y, H    Dim sExNameForOut As String
/ e$ S9 Q* ]+ k    Dim sExNameForIn As String
    Dim sSavePath As String
; R# u0 j* _* u$ i$ e   

    sExNameForIn = "SLDPRT"
- T6 L$ L* S0 V6 F' R8 O- u  |    sExNameForOut = "dxf"
* J+ N* G' O2 F1 P2 y& C8 }   
    Set partDoc = swApp.ActiveDoc
    path = partDoc.GetPathName
( Z* U" z1 C( B( X& z    Set f = fso.GetFile(path)
   
" u6 Q& u( b8 a0 c9 _" y! }    If Not partDoc Is Nothing Then
; L  X' n$ L1 H! l7 h- U2 w' s3 ^       If IsSheet(partDoc) Then
/ x) O- P5 {) s) M4 g# Q           sSavePath = fso.GetParentFolderName(f) & "\" & DXF_SAVE_DIR & "\"
           If Not fso.FolderExists(sSavePath) Then
# E* j0 g7 f: e4 ^# @              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
/ T5 z7 H. ^2 l/ u0 f4 k* g$ `           MsgBox ("当前文件不是钣金!")
; T1 n" A1 h0 g           End
       End If
7 s: q; c6 [0 Z    End If
End Sub

slzhrb

厉害！！！！

qiuli108028