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

liuzhanping9605

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

+ l7 a5 Y+ d; R0 B下面方法可另存pdf，却不能另存dxf
- d6 K! G# B5 ~! }7 H4 DPrivate Sub cmdExportDxf_Click()
    Dim f As File
# f- K: }; H% u* @    Dim fo As Folder
0 |. h4 I6 }& B+ Z3 K5 }8 s    Dim sName As String
: P$ y" V& E4 [' v' T    Dim sExNameForOut As String
$ M: P3 E' a" j) R% U    Dim sExNameForIn As String
+ T5 a# E6 S! X: ~. x; `- h
/ J' L1 `  O  t. e0 N5 z    sExNameForIn = "SLDPRT"
    sExNameForOut = "dxf"

    Set fo = fso.GetFolder(txtDir)
- @& k) f" H, d+ a4 e, J' m
    If Not fso.FolderExists(fo) Then
       MsgBox "目录不存在！"
       Exit Sub
" o3 m; }3 [, {$ @    End If
( A- t# o- O' M
    Dim retVal As Boolean
    For Each f In fo.Files
8 o! Q) M7 d/ M! c6 j       Dim sSaveName As String
! {2 w4 s. b  D  S5 m# k0 G1 ?       Dim longstatus As Long
9 y0 U! o4 |0 I4 |( r: f/ C       Dim longwarnings As Long
' ~6 Q( O% @& d% x; x9 l* v# i
       If fso.GetExtensionName(f) = sExNameForIn Then
" F; \3 Z$ Z+ c& |3 h3 \  I          If Not Left(fso.GetBaseName(f), 2) = "~$" Then
'             Set part = swApp.ActiveDoc
  _  s; \5 m) K8 K1 K# ^             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
* E2 b. m( X' s; X( v% q" F# }  i          End If
       End If
'       part.Close
        swApp.CloseDoc (f)
    Next
4 e% h% u% W% X# R8 _End Sub

4 z- `6 t0 {  b. n' W+ x

liuzhanping9605

没有人知道吗？

liuzhanping9605

看来还是得靠自己

liuzhanping9605

自己看SDK搞定，分享一下

/ X  i6 T- {' k0 g/ W& ]'************************************************************
+ g) N, Q# f. e, X'函数名：
'功能：导出当前钣金件为dxf
Private Sub cmdExportDxfForCurrent_Click()
    Dim partDoc As SldWorks.ModelDoc2
7 |" f' d( ]$ g    Dim swModelDocExt As SldWorks.ModelDocExtension
    Dim boolRetVal As Boolean
- x  Y& O* f4 E* d1 A) J; m    Dim sSaveName As String
    Dim f As File
% \/ M, T" W" G$ j) O    Dim path As String
8 U' b* x* U8 l+ s8 w    Dim sExNameForOut As String
! F8 L  n6 d. E  i2 |) Q2 V    Dim sExNameForIn As String
    Dim sSavePath As String
   

    sExNameForIn = "SLDPRT"
$ t4 _" G3 a  q  O    sExNameForOut = "dxf"
   
    Set partDoc = swApp.ActiveDoc
8 Q# h5 W7 q& W* {    path = partDoc.GetPathName
    Set f = fso.GetFile(path)
0 m* Z$ y: p9 c7 ^" j2 c& e   
0 {8 \* T. `" _, u* f    If Not partDoc Is Nothing Then
       If IsSheet(partDoc) Then
' [7 X) @/ E5 j. I3 b# g6 m           sSavePath = fso.GetParentFolderName(f) & "\" & DXF_SAVE_DIR & "\"
           If Not fso.FolderExists(sSavePath) Then
              Call fso.CreateFolder(sSavePath)
           End If
7 R# G; E# R* ], g( k           sSaveName = sSavePath & fso.GetBaseName(f) & "." & sExNameForOut
5 ^  a6 m4 h, V  |% p/ K           
           Set swModelDocExt = partDoc.Extension
% X# [5 P# s2 i1 {9 ]           boolRetVal = partDoc.ExportFlatPatternView(sSaveName, 0)
# T! A0 Y  |% Z4 M9 B- O           Call swModelDocExt.SaveAs(sSaveName, 0, 0, Nothing, 0, 0)
! q- V" G& R" |9 f# Q9 Z0 M       Else
           MsgBox ("当前文件不是钣金!")
           End
       End If
    End If
End Sub
  r9 x' d( D9 Y: \: e

slzhrb

厉害！！！！

qiuli108028