Bonjour,
Je suis actuellement dans une impasse sur ce code Pack And Go.
Cahier des charge :
- Récupérer le pack and Go d’un assemblage /Ok pou moi/
- Lister tous les fichiers qui contiennent « OF » /Ok pou moi/
- Garder uniquement cela /Ok pou moi/
- Les renommer avec un nouveau numéro /Ok pou moi/
- Créer ma nouvelle liste Pack And Go /Ok pou moi/
- Générer le Pack And Go // Ne fonctionne pas //
Ma table filesArray est bien rempli, je l’appelle avec SetDocumentSaveToNames.
Sauf qu’elle n’en tiens pas compte.
La fonction SavePackAndGo ne fonctionne pas.
Merci par avance de vos réponses.
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swPackAndGo As PackAndGo
Dim statusArray As Variant
Dim status As Boolean
Dim statuses As Boolean
Dim tableauSource() As String
Dim tableauResultat() As String
Dim i As Long, j As Long
Dim searchString As String
Dim numeroRecherche As String
Dim count As Long
Dim resultat As String
Dim compteurOF As Collection
Dim numeroOF As Variant
Dim RsultatOF As String
Dim filesArray() As String
Dim ListeOF() As String
' Initialiser SolidWorks
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
' Vérifier si un document est ouvert
If swModel Is Nothing Then
MsgBox "Veuillez ouvrir un document SolidWorks."
Exit Sub
End If
Set swModelDocExt = swModel.Extension
' Créer l'objet Pack and Go
Set swPackAndGo = swModelDocExt.GetPackAndGo
' Include any drawings, SOLIDWORKS Simulation results, and SOLIDWORKS Toolbox components
swPackAndGo.IncludeDrawings = False
Debug.Print " Include drawings: " & swPackAndGo.IncludeDrawings
swPackAndGo.IncludeSimulationResults = False
Debug.Print " Include SOLIDWORKS Simulation results: " & swPackAndGo.IncludeSimulationResults
swPackAndGo.IncludeToolboxComponents = False
Debug.Print " Include SOLIDWORKS Toolbox components: " & swPackAndGo.IncludeToolboxComponents
' Obtenir les informations sur les fichiers
swPackAndGo.GetDocumentNames namesArray
' Structure répertoire
swPackAndGo.FlattenToSingleFolder = True
' Définir la chaîne de recherche
searchString = "OF "
origineOF = "30277"
nouvelOF = "45000"
' Utiliser Filter pour extraire les éléments contenant la chaîne de recherche
tableauResultat = Filter(namesArray, searchString, True, vbTextCompare)
'myPath = "C:\BE\1 Plans 2024\Mathieu"
For i = LBound(tableauResultat) To UBound(tableauResultat)
RsultatOF = tableauResultat(i)
j = j + 1
Debug.Print RsultatOF
Next i
ReDim filesArray(0 To j - 1)
For i = 0 To UBound(tableauResultat)
FileName = GetFileName(CStr(tableauResultat(i)))
' Remplacer la chaîne si spécifié
If origineOF <> "" Then
FileName = Replace(FileName, origineOF, nouvelOF)
FileNames = FileName
End If
filesArray(k) = FileNames
Debug.Print "Nouveau fichier " & filesArray(k)
k = k + 1
'Debug.Print FileNames
Next
myPath = "C:\BE\1 Plans 2024\Mathieu"
status = swPackAndGo.SetSaveToName(True, myPath)
statuses = swPackAndGo.SetDocumentSaveToNames(filesArray)
statusArray = swModelDocExt.SavePackAndGo(swPackAndGo)
End Sub
Function GetFileName(path As String) As String
GetFileName = Right(path, Len(path) - InStrRev(path, ""))
End Function
PackAndGo.zip (1,1 Mo)
MTD-PackAndGo-teste.swp (40,5 Ko)
