Option Explicit

Public Enum swDocumentTypes_e
    swDocNONE = 0       ' Used to be TYPE_NONE

    swDocPART = 1       ' Used to be TYPE_PART

    swDocASSEMBLY = 2   ' Used to be TYPE_ASSEMBLY

    swDocDRAWING = 3    ' Used to be TYPE_DRAWING
End Enum
 
Dim swApp                       As SldWorks.SldWorks
Dim swModel                     As SldWorks.ModelDoc2
Dim swModelDocExt               As ModelDocExtension
Dim swCustProp                  As CustomPropertyManager
Dim swDraw                      As SldWorks.DrawingDoc
Dim swView                      As SldWorks.View

Dim vSheetNameArr               As Variant
Dim vSheetName                  As Variant

Dim I                           As Long
Dim nDocType                    As Long
Dim nErrors                     As Long
Dim nWarnings                   As Long
Dim op                          As Long
Dim suppr                       As Long

Dim boolstatus                  As Boolean
Dim bRet                        As Boolean
Dim FileConnu                   As Boolean
Dim WasResolved                 As Boolean

Dim nbConnu                     As Integer

Dim NameRep                     As String
Dim sModelName                  As String
Dim sPathName                   As String
Dim ValOut                      As String
Dim ResolvedValOut              As String
Dim TabConnu(10000)             As String
Dim Rep                         As String

'Variables Système
Dim fs                  As Scripting.FileSystemObject

Sub main()
    
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
boolstatus = swApp.SetUserPreferenceIntegerValue(swStepAP, 214) 'Force la version AP214
boolstatus = swApp.SetUserPreferenceIntegerValue(swStepExportPreference, swAcisOutputGeometryPreference_e.swAcisOutputAsSolidAndSurface) 'Force l'export en format Solid/Surface Geometry

If swModel Is Nothing Then
    MsgBox ("Pas de document ouvert")
    Else
        If swModel.GetType <> 3 Then
            MsgBox ("Il ne s'agît pas d'une mise en plan")
        Else
            Set swDraw = swModel
                vSheetName = swDraw.GetSheetNames
                vSheetNameArr = swDraw.GetSheetNames

                For Each vSheetName In vSheetNameArr
        
                    bRet = swDraw.ActivateSheet(vSheetName): Debug.Assert bRet
                    Set swView = swDraw.GetFirstView 'Sélectionne le fond de plan
                    Set swView = swView.GetNextView  'Passe à la vue suivante pour exclure le fond de plan
                    'Debug.Print swView.GetName2
                
                    While Not swView Is Nothing
           
                    ' Determine if this is a view of a part or assembly

                        sModelName = swView.GetReferencedModelName

                        sModelName = LCase(sModelName)
        
        
                        FileConnu = False
        
                        If InStr(sModelName, "sldprt") > 0 Then
                            nDocType = swDocPART
                        ElseIf InStr(sModelName, "slasm") > 0 Then
                            nDocType = swDocASSEMBLY
                        Else
                            nDocType = swDocNONE
                            Exit Sub
                        End If
                       
                       If nDocType = 1 Then
                        For I = 1 To nbConnu
                            If UCase(sModelName) = TabConnu(I) Then
                                FileConnu = True
                            End If
                        Next
                                If Not FileConnu Then
                                nbConnu = nbConnu + 1
                                TabConnu(nbConnu) = UCase(sModelName)
                                Call Export
                            End If
                        End If
        
                        Set swView = swView.GetNextView
    Wend

Next vSheetName
End If
End If
End Sub
Sub Export()
Set swModel = swApp.OpenDoc6(sModelName, nDocType, swOpenDocOptions_Silent, "", nErrors, nWarnings)
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")
boolstatus = swCustProp.Get5("reference", False, ValOut, ResolvedValOut, WasResolved)
NameRep = ValOut
Call TestRep
sPathName = Rep & ValOut & ".step"
If Dir(sPathName, vbHidden) <> "" Then              'Test l'existence du fichier
    suppr = MsgBox("Le fichier " & sPathName & " existe déjà, voulez vous le supprimer?", vbYesNo) 'Message utilisateur confirmation de suppression oui/non
        If suppr = vbYes Then                       'Réponse Oui
            Kill (sPathName) 'Suppression du fichier existant
            swModel.SaveAs2 sPathName, 0, True, False  'Enregistrement du fichier
            op = MsgBox("Le fichier a été enregistré sous " & sPathName & vbNewLine)
            Else                                    'Réponse NON
        MsgBox ("Fichier conservé")                 'Message utilisateur
        End If
        Else
        swModel.SaveAs2 sPathName, 0, True, False      'Enregistrement du fichier
        op = MsgBox("Le fichier a été enregistré sous " & sPathName) 'Message utilisateur
    End If
End Sub
Sub TestRep()
Set fs = New Scripting.FileSystemObject
    Rep = "C:\Export\" & NameRep & "\"
    ' test si le repertoire existe
        If Not fs.FolderExists("C:\Export\") Then 'Test si le dossier principal existe si non, création
         fs.CreateFolder ("C:\Export\")
         End If
         If Not fs.FolderExists(Rep) Then 'Test si le sous-dossier existe si non, création
         fs.CreateFolder (Rep)
         End If
    Set fs = Nothing
End Sub