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

liuzhanping9605

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

下面方法可另存pdf，却不能另存dxf
0 U4 ~/ {7 `: s* V8 X2 R9 ~Private Sub cmdExportDxf_Click()
    Dim f As File
! f& ^3 W/ @1 `, r7 r" O* o    Dim fo As Folder
    Dim sName As String
    Dim sExNameForOut As String
    Dim sExNameForIn As String
( I4 ]& P* E* H1 ]3 H
: P$ T( x; F- r    sExNameForIn = "SLDPRT"
' S) u/ Z+ v% e6 o+ f) `1 z: t    sExNameForOut = "dxf"
/ n) Q+ h8 r' o0 h" p6 E3 {
    Set fo = fso.GetFolder(txtDir)
% U0 J& E, u9 y: s
" q* k5 K3 J  |. t. o: @    If Not fso.FolderExists(fo) Then
       MsgBox "目录不存在！"
       Exit Sub
$ a- }& a$ e# o5 `" X/ j    End If
0 Y$ v/ C8 z1 B0 t* U6 _
    Dim retVal As Boolean
    For Each f In fo.Files
, P+ o$ c2 |* B3 b( I       Dim sSaveName As String
, m" ]" z5 ]# H; t" C& }0 y$ ]  o- H       Dim longstatus As Long
% }: ?' S  l2 e       Dim longwarnings As Long

: E- j9 O) ?' m/ S" d. l7 Z       If fso.GetExtensionName(f) = sExNameForIn Then
3 I7 N5 z& p9 Z          If Not Left(fso.GetBaseName(f), 2) = "~$" Then
'             Set part = swApp.ActiveDoc
             Set part = swApp.OpenDoc6(f, 1, 0, "", longstatus, longwarnings)
$ ?, z" Z! _9 v' `! C$ R             If IsSheet(part) = True Then
                sSaveName = fso.GetParentFolderName(f) & "\" & fso.GetBaseName(f) & "." & sExNameForOut
" t0 n" {( k( |% ^0 u3 D4 `; K# _                retVal = part.SaveAs3(sSaveName, 0, 0)
! C: Y" |( d* {  Z$ l. X'                retVal = part.SaveAs4(sSaveName, 0, 0, 0, 0)

3 ~* X/ \6 Y7 w" u             End If
; O/ R4 W. ~" F  k& k          End If
8 l: p+ R/ g2 O       End If
'       part.Close
        swApp.CloseDoc (f)
    Next
0 H- h. G7 L0 G( c- Q% u: y: JEnd Sub

liuzhanping9605

没有人知道吗？

liuzhanping9605

看来还是得靠自己

liuzhanping9605

自己看SDK搞定，分享一下
( _; [5 v- @( T! R+ K. R; B
'************************************************************
- W0 {/ {. Y0 g. m6 @9 b& ^'函数名：
'功能：导出当前钣金件为dxf
Private Sub cmdExportDxfForCurrent_Click()
    Dim partDoc As SldWorks.ModelDoc2
    Dim swModelDocExt As SldWorks.ModelDocExtension
, P% W7 A3 N/ H* L    Dim boolRetVal As Boolean
    Dim sSaveName As String
) v9 U5 k6 A& T2 O    Dim f As File
    Dim path As String
3 a: C7 e% {2 A7 x    Dim sExNameForOut As String
# ^5 @1 s9 _) d; O5 }% M  T+ \    Dim sExNameForIn As String
+ s) d2 T; _$ o5 u    Dim sSavePath As String
   
5 {! d4 m" Q6 ^4 P1 F, }
2 I( _$ b; x- J! a" M# Y2 _9 D    sExNameForIn = "SLDPRT"
) ?1 e  V" Q9 I4 G7 a  V    sExNameForOut = "dxf"
   
    Set partDoc = swApp.ActiveDoc
    path = partDoc.GetPathName
    Set f = fso.GetFile(path)
( y( u( o, d; w+ s) Y   
2 d, a: S0 A+ l( @; W- o5 s    If Not partDoc Is Nothing Then
4 _1 I2 z4 q, D8 E       If IsSheet(partDoc) Then
           sSavePath = fso.GetParentFolderName(f) & "\" & DXF_SAVE_DIR & "\"
7 g$ E3 w4 s5 p$ s5 m           If Not fso.FolderExists(sSavePath) Then
% Q5 E( Z  H7 j; J! j              Call fso.CreateFolder(sSavePath)
, C8 T# s! H4 |. |/ c1 K7 j           End If
' h4 Q8 W7 u. o4 @           sSaveName = sSavePath & fso.GetBaseName(f) & "." & sExNameForOut
1 T' s8 e/ ~" _! q           
           Set swModelDocExt = partDoc.Extension
( P& _4 h* V# o9 @           boolRetVal = partDoc.ExportFlatPatternView(sSaveName, 0)
1 B- V) ]! L5 K/ X) i3 M7 D           Call swModelDocExt.SaveAs(sSaveName, 0, 0, Nothing, 0, 0)
       Else
. z) F1 T- R  E3 n; j           MsgBox ("当前文件不是钣金!")
           End
8 A, P7 X4 D8 c1 p- f+ H" U       End If
    End If
End Sub

4 n, L/ y" m4 O, _

slzhrb

厉害！！！！

qiuli108028