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

liuzhanping9605

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

下面方法可另存pdf，却不能另存dxf
Private Sub cmdExportDxf_Click()
    Dim f As File
    Dim fo As Folder
    Dim sName As String
& D! S* Y9 a. m& w: ^" Y    Dim sExNameForOut As String
( ]# i' r% i! M    Dim sExNameForIn As String
1 V' c) _' L2 I4 F
3 o3 A7 m3 h, q; C/ B; K    sExNameForIn = "SLDPRT"
2 r" i5 U. p4 d. r# m    sExNameForOut = "dxf"
1 D" B8 ^0 E$ _) |) ]2 f
    Set fo = fso.GetFolder(txtDir)
* }5 U0 l3 d; ^" m) G( O# k
: l0 W$ O1 k4 c6 T: q    If Not fso.FolderExists(fo) Then
       MsgBox "目录不存在！"
+ \5 M0 W, j7 y7 ~5 u, i; {       Exit Sub
    End If
" U- o3 h& q' o( Q% Q: ?
    Dim retVal As Boolean
4 a0 I9 L# k# V, k1 r1 }/ T! c' v    For Each f In fo.Files
       Dim sSaveName As String
       Dim longstatus As Long
/ u8 h) V/ }$ a3 a* |7 ]       Dim longwarnings As Long
8 c$ ]- Q0 _" h
       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)
6 W5 q" ~/ i: X3 A0 v1 `0 c( s7 p             If IsSheet(part) = True Then
1 D8 s5 q. g: k$ c5 d7 K5 ]                sSaveName = fso.GetParentFolderName(f) & "\" & fso.GetBaseName(f) & "." & sExNameForOut
0 \. ~% E( o8 J                retVal = part.SaveAs3(sSaveName, 0, 0)
% K3 k2 S6 \+ B+ D6 Z& c0 l'                retVal = part.SaveAs4(sSaveName, 0, 0, 0, 0)
! f; e+ L( M' r' P( G
             End If
          End If
/ ~% N( q2 G0 g) S5 h8 h4 v       End If
'       part.Close
, O: ?3 q2 a' |, m: E9 ~% ?        swApp.CloseDoc (f)
    Next
End Sub

+ x6 n' X5 \, v8 g

liuzhanping9605

没有人知道吗？

liuzhanping9605

看来还是得靠自己

liuzhanping9605

自己看SDK搞定，分享一下
; |- e9 e7 N2 Q  S
; m2 j) }7 i: w2 z'************************************************************
'函数名：
3 U/ Z3 r) Z) K9 A2 {'功能：导出当前钣金件为dxf
Private Sub cmdExportDxfForCurrent_Click()
    Dim partDoc As SldWorks.ModelDoc2
1 f) n; Q2 F9 F0 R. k: J    Dim swModelDocExt As SldWorks.ModelDocExtension
    Dim boolRetVal As Boolean
    Dim sSaveName As String
1 i: K: T$ ?. l7 ?4 n  D    Dim f As File
3 A4 I2 R- I* q    Dim path As String
7 |: f0 ^, i* B- N* E' a    Dim sExNameForOut As String
    Dim sExNameForIn As String
% D8 @( F0 y+ {% s& R* y5 p9 _* I3 D    Dim sSavePath As String
' D7 S4 Y- u  l- f   
! H1 R7 C% i# O4 g) |; @
    sExNameForIn = "SLDPRT"
* r! R" V. o/ o" Q3 h3 ]8 Q/ A    sExNameForOut = "dxf"
   
  }2 X- T0 Q  j9 M3 E    Set partDoc = swApp.ActiveDoc
6 W9 h9 V) O- e. p- b5 W2 z1 k    path = partDoc.GetPathName
4 ]9 J) w  @! M" p0 M: Z9 o    Set f = fso.GetFile(path)
   
  z# m* G- z  ^; `    If Not partDoc Is Nothing Then
8 J, a" n7 i  H, y       If IsSheet(partDoc) Then
+ G0 s+ C! _' Z: L2 _           sSavePath = fso.GetParentFolderName(f) & "\" & DXF_SAVE_DIR & "\"
" e  {# K/ J. S           If Not fso.FolderExists(sSavePath) Then
              Call fso.CreateFolder(sSavePath)
           End If
8 P' v! E! w# L           sSaveName = sSavePath & fso.GetBaseName(f) & "." & sExNameForOut
; `) I. w2 l5 I8 \9 h. O. Y           
           Set swModelDocExt = partDoc.Extension
$ m" J8 {( A% g( }: M           boolRetVal = partDoc.ExportFlatPatternView(sSaveName, 0)
6 }% \( v) Y" D( s% |$ V0 M           Call swModelDocExt.SaveAs(sSaveName, 0, 0, Nothing, 0, 0)
       Else
/ l$ ^; ^2 [2 q           MsgBox ("当前文件不是钣金!")
' a5 ~$ a# B1 i" ~/ R8 {           End
1 ?. l) d) K5 e: _7 a       End If
    End If
# {' p: ]" @9 ^( ~8 aEnd Sub
" d7 ]: r( ?" \" g- W( [7 P! |2 t
" B; e# \5 C8 d0 j* H

slzhrb

厉害！！！！

qiuli108028