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

liuzhanping9605

    一般要将钣金件展开图拷过数控编程，一个个另存效率很低，不知有没有批量方法？
3 p5 Q$ r9 T& D+ m! i2 n: g/ m
* s# c! |8 ~2 m, Y下面方法可另存pdf，却不能另存dxf
Private Sub cmdExportDxf_Click()
6 S" l  K5 l# Y% ?1 H* `4 G  Y    Dim f As File
    Dim fo As Folder
. P. h2 h$ B' t9 |0 e    Dim sName As String
4 G8 e& |" F2 {5 G) A) u; G    Dim sExNameForOut As String
/ D  q) l! M7 c& E: M    Dim sExNameForIn As String
/ j, y' e; T9 x
    sExNameForIn = "SLDPRT"
% C0 S& x8 }( u$ n* }    sExNameForOut = "dxf"

9 [3 Y9 h+ N7 h( E    Set fo = fso.GetFolder(txtDir)
2 q$ g0 o. l, S5 g2 i; [
( I  y! b8 `, }' T" k1 M& n    If Not fso.FolderExists(fo) Then
# E8 w5 s: l8 A       MsgBox "目录不存在！"
8 j6 L6 l2 p& i" g, V) W       Exit Sub
& K! }( N% ^, H8 F+ q  c& W    End If

    Dim retVal As Boolean
    For Each f In fo.Files
& H  {% ]1 o( ^: \0 Z. w       Dim sSaveName As String
       Dim longstatus As Long
       Dim longwarnings As Long
6 K4 b) t/ f' V# @; X8 H
, z: r# d3 P0 A! T) n( ^       If fso.GetExtensionName(f) = sExNameForIn Then
( u: ]/ }/ G* q) k          If Not Left(fso.GetBaseName(f), 2) = "~$" Then
'             Set part = swApp.ActiveDoc
             Set part = swApp.OpenDoc6(f, 1, 0, "", longstatus, longwarnings)
. ^, E* e  I) Y2 x3 W6 S             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)

" r* V0 I; a6 S3 i5 z; \4 h! y$ B, z9 P             End If
          End If
       End If
9 [3 s; J: h& v/ C9 y3 T'       part.Close
        swApp.CloseDoc (f)
) _( Z" S; \% L- o: [" C6 v( E    Next
% W7 T2 J% M8 T0 QEnd Sub
+ u, b9 k) ~3 `# D8 U1 X( N
2 h, f5 h& S( ^& W

liuzhanping9605

没有人知道吗？

liuzhanping9605

看来还是得靠自己

liuzhanping9605

自己看SDK搞定，分享一下

" Q  \; d* F% y) \7 |) V: e'************************************************************
0 a* p+ t2 X8 \/ F2 Y'函数名：
. \5 Y1 Q/ H: Y'功能：导出当前钣金件为dxf
Private Sub cmdExportDxfForCurrent_Click()
0 Z/ e* ?7 S. N  s6 _; E    Dim partDoc As SldWorks.ModelDoc2
7 I/ w. m+ e: E( ^- |# U# v    Dim swModelDocExt As SldWorks.ModelDocExtension
    Dim boolRetVal As Boolean
- Z! J' @& e5 A: \6 ]    Dim sSaveName As String
    Dim f As File
2 X' z5 m' Q  S+ {0 b# t& W    Dim path As String
    Dim sExNameForOut As String
    Dim sExNameForIn As String
6 W! Z, H, f- G* n/ V* @) {5 n    Dim sSavePath As String
   
& y% e1 p% e# u8 i/ o
8 M7 h8 X- W6 k2 ]' m& ~( w    sExNameForIn = "SLDPRT"
    sExNameForOut = "dxf"
! G4 f: C; i  s5 w; \   
    Set partDoc = swApp.ActiveDoc
6 v. `+ G5 z2 ?! l, r) w+ M    path = partDoc.GetPathName
+ ]  g, ~2 s$ K    Set f = fso.GetFile(path)
6 g. C/ }7 X' r$ M, V' l# n, n   
    If Not partDoc Is Nothing Then
6 w8 {2 h& {3 ~6 ~       If IsSheet(partDoc) Then
* E: z/ }; F& D( W8 r8 O9 a           sSavePath = fso.GetParentFolderName(f) & "\" & DXF_SAVE_DIR & "\"
           If Not fso.FolderExists(sSavePath) Then
              Call fso.CreateFolder(sSavePath)
           End If
' y; }8 U& U8 _" b! F% A           sSaveName = sSavePath & fso.GetBaseName(f) & "." & sExNameForOut
3 M, e" p3 l# [2 E! O$ H# v           
1 p" `  `$ c7 N  A           Set swModelDocExt = partDoc.Extension
           boolRetVal = partDoc.ExportFlatPatternView(sSaveName, 0)
           Call swModelDocExt.SaveAs(sSaveName, 0, 0, Nothing, 0, 0)
/ P0 d; d: m. R       Else
           MsgBox ("当前文件不是钣金!")
+ e( l% H2 O) E4 J7 f           End
       End If
, R5 @" v* R- k% j    End If
End Sub
/ H1 p8 t& i+ _$ {1 f8 l
% |2 l0 P- E4 w4 A0 |) E

slzhrb

厉害！！！！

qiuli108028