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

liuzhanping9605

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

下面方法可另存pdf，却不能另存dxf
Private Sub cmdExportDxf_Click()
    Dim f As File
( {; W" h; W# [4 t    Dim fo As Folder
    Dim sName As String
3 L1 z+ O, n  b! `9 l& H0 a; o1 i7 A    Dim sExNameForOut As String
    Dim sExNameForIn As String
. W0 E. S. E0 w  x& M9 m9 N
$ K, O! U+ O* T% H6 }  |% K) {    sExNameForIn = "SLDPRT"
    sExNameForOut = "dxf"
! F2 r' I7 E# @" O9 s" L! U
; d' y7 B$ U2 q1 g* M/ h  @    Set fo = fso.GetFolder(txtDir)

4 |9 z4 P; p5 ?( P! f    If Not fso.FolderExists(fo) Then
: t/ e* [$ r) I3 }       MsgBox "目录不存在！"
       Exit Sub
% X. ?+ r5 U7 f8 ]" ]# h    End If

5 h7 u; a! s$ w6 F+ E9 A5 }& W    Dim retVal As Boolean
    For Each f In fo.Files
( Y8 _  E* l$ b0 m: s6 B/ E       Dim sSaveName As String
       Dim longstatus As Long
- ~8 s$ `4 T1 @       Dim longwarnings As Long

       If fso.GetExtensionName(f) = sExNameForIn Then
* n3 F- D% Q& H2 {  a( g4 `          If Not Left(fso.GetBaseName(f), 2) = "~$" Then
, Z' y6 i- I$ Q2 `: z0 W3 ]+ n'             Set part = swApp.ActiveDoc
3 {$ P+ a6 S; h+ z9 m+ y% \/ p# p             Set part = swApp.OpenDoc6(f, 1, 0, "", longstatus, longwarnings)
4 \$ f% R. h& j; E. M- |             If IsSheet(part) = True Then
                sSaveName = fso.GetParentFolderName(f) & "\" & fso.GetBaseName(f) & "." & sExNameForOut
3 f% }' `1 k7 j! G                retVal = part.SaveAs3(sSaveName, 0, 0)
'                retVal = part.SaveAs4(sSaveName, 0, 0, 0, 0)

             End If
          End If
- }! o( R4 Z3 Q. n) ?* |9 T  N" Z       End If
'       part.Close
        swApp.CloseDoc (f)
    Next
) P$ W' A0 }, [End Sub
* H( ~( E6 j1 a; A( E: L, a
( S7 b( Q$ P8 v2 t3 j" s, B

liuzhanping9605

没有人知道吗？

liuzhanping9605

看来还是得靠自己

liuzhanping9605

自己看SDK搞定，分享一下

& O9 z! d) |2 ]5 C. N4 ]( A; F: s'************************************************************
5 W/ r# A; @; [" Z4 V' d. p+ j" ['函数名：
'功能：导出当前钣金件为dxf
Private Sub cmdExportDxfForCurrent_Click()
    Dim partDoc As SldWorks.ModelDoc2
8 d! x: l. ~6 q5 t3 v    Dim swModelDocExt As SldWorks.ModelDocExtension
    Dim boolRetVal As Boolean
    Dim sSaveName As String
9 }7 V: B4 S) Y; J    Dim f As File
8 T1 g+ X4 |" ?4 t& v/ m    Dim path As String
0 T# W2 I4 p4 I7 W. I    Dim sExNameForOut As String
    Dim sExNameForIn As String
    Dim sSavePath As String
   

    sExNameForIn = "SLDPRT"
    sExNameForOut = "dxf"
   
" v7 q4 Q$ _7 Q: R/ [( @( T! ]    Set partDoc = swApp.ActiveDoc
- z) q: Y/ S4 g. ^' S    path = partDoc.GetPathName
    Set f = fso.GetFile(path)
   
$ X4 E1 r: Z) M2 Y    If Not partDoc Is Nothing Then
       If IsSheet(partDoc) Then
2 `) _3 K4 ^% z' v  ^           sSavePath = fso.GetParentFolderName(f) & "\" & DXF_SAVE_DIR & "\"
           If Not fso.FolderExists(sSavePath) Then
              Call fso.CreateFolder(sSavePath)
           End If
/ |8 v: C: M0 e* A! W           sSaveName = sSavePath & fso.GetBaseName(f) & "." & sExNameForOut
+ d) ^  f2 R( y/ F) t& Y! Y           
. N5 W7 i( N8 O* S           Set swModelDocExt = partDoc.Extension
6 S- Z/ s2 G! J* y) x  C           boolRetVal = partDoc.ExportFlatPatternView(sSaveName, 0)
           Call swModelDocExt.SaveAs(sSaveName, 0, 0, Nothing, 0, 0)
$ d6 [3 V( R, ?! l, t5 Z       Else
           MsgBox ("当前文件不是钣金!")
' T" N1 u, n$ b7 U7 J) t           End
       End If
    End If
  \8 q. c* `+ bEnd Sub

slzhrb

厉害！！！！

qiuli108028