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

liuzhanping9605

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

" n6 G6 [9 ]/ x; D) F; C9 T下面方法可另存pdf，却不能另存dxf
Private Sub cmdExportDxf_Click()
. b+ R: G) {& ~5 ^' }) E    Dim f As File
    Dim fo As Folder
; p# i  P. ?! C( b5 D9 {$ I    Dim sName As String
    Dim sExNameForOut As String
    Dim sExNameForIn As String

    sExNameForIn = "SLDPRT"
7 \: i2 {% o7 w, z5 N8 L+ }    sExNameForOut = "dxf"

. s; J5 ]% e6 i+ T7 B3 z3 p    Set fo = fso.GetFolder(txtDir)

3 ?- t8 {" I* f" _  {$ C8 j7 r, w    If Not fso.FolderExists(fo) Then
       MsgBox "目录不存在！"
3 K7 P! M- T! Y       Exit Sub
    End If
* T: X5 T! [! R8 n
) B- Z7 N0 l/ W% U    Dim retVal As Boolean
1 c1 p" E1 W) J1 z" d    For Each f In fo.Files
       Dim sSaveName As String
/ C; C) P1 ]$ r0 X) `       Dim longstatus As Long
       Dim longwarnings As Long
' y& w' B$ E$ D5 F" E6 _
       If fso.GetExtensionName(f) = sExNameForIn Then
4 X" I7 R9 ?1 b          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)
' _( ~& J3 b% n3 r'                retVal = part.SaveAs4(sSaveName, 0, 0, 0, 0)
' E3 M) X0 A, r, W  o& W
" h  W/ s) x  f7 e* g( e             End If
, K0 P" l3 p6 d) d: `          End If
       End If
'       part.Close
        swApp.CloseDoc (f)
0 I/ d4 i: g7 ^* v, @! v    Next
End Sub
6 M" `# p+ b8 m: Q' k& S! m

liuzhanping9605

没有人知道吗？

liuzhanping9605

看来还是得靠自己

liuzhanping9605

自己看SDK搞定，分享一下

9 n: C$ X! q2 u. Q& a9 O5 T'************************************************************
3 h8 F" N7 I3 \. h) M'函数名：
" |1 W: X$ L& C5 ['功能：导出当前钣金件为dxf
Private Sub cmdExportDxfForCurrent_Click()
    Dim partDoc As SldWorks.ModelDoc2
    Dim swModelDocExt As SldWorks.ModelDocExtension
0 @. C& c* n8 k8 k2 q    Dim boolRetVal As Boolean
" i9 X/ ~: I3 U/ }    Dim sSaveName As String
    Dim f As File
    Dim path As String
    Dim sExNameForOut As String
    Dim sExNameForIn As String
, Q1 j# q+ S/ e$ R9 a5 [    Dim sSavePath As String
   
% O& o1 r7 C) T, |! B1 q( {
: [/ i0 l/ m+ A6 C/ d8 \% V) F    sExNameForIn = "SLDPRT"
1 l! \% A/ E% F    sExNameForOut = "dxf"
. _& L( K( t' M& _7 q   
7 ?% R1 x* E% B) Z/ s    Set partDoc = swApp.ActiveDoc
; P4 k3 _) p: v7 y    path = partDoc.GetPathName
/ ^+ G! c! \1 X8 E: L    Set f = fso.GetFile(path)
   
& [* k) A, i2 k6 m    If Not partDoc Is Nothing Then
' ?, g! s+ c2 L4 l7 E       If IsSheet(partDoc) Then
8 }, i) s8 Z. x           sSavePath = fso.GetParentFolderName(f) & "\" & DXF_SAVE_DIR & "\"
9 k# A' `! c9 N* E; z           If Not fso.FolderExists(sSavePath) Then
$ F6 h4 {0 A6 d. n0 ~/ ^              Call fso.CreateFolder(sSavePath)
           End If
) j6 [0 W/ Z2 K           sSaveName = sSavePath & fso.GetBaseName(f) & "." & sExNameForOut
4 b+ R9 q) ]- h: D           
           Set swModelDocExt = partDoc.Extension
           boolRetVal = partDoc.ExportFlatPatternView(sSaveName, 0)
           Call swModelDocExt.SaveAs(sSaveName, 0, 0, Nothing, 0, 0)
       Else
1 ^! J, q) v8 v$ f* [* l' H: k( K" W$ T# y           MsgBox ("当前文件不是钣金!")
9 q) l* J2 E) u  ]/ q           End
) v" M8 ^' R4 |8 n1 m  T3 [* h       End If
# Q3 P* x8 u4 k8 ^" {! [8 }    End If
$ T7 V1 S6 n1 e+ g3 x% P  t) gEnd Sub
2 J8 n& G9 L: i3 B
# `  G  C# {0 k

slzhrb

厉害！！！！

qiuli108028