Hallo
Ich befinde mich derzeit in einer Sackgasse mit diesem Pack And Go-Code.
Leistungsbeschreibung:
- Holen Sie sich das Paket und gehen Sie von einer Baugruppe aus /Ok für mich/
- Listet alle Dateien auf, die " OF " /Ok für mich/ enthalten
- Behalte nur das /Ok für mich/
- Benennen Sie sie mit einer neuen Nummer um /Ok für mich/
- Erstelle meine neue Pack And Go-Liste /Ok für mich/
- Pack And Go generieren // Funktioniert nicht //
Meine filesArray-Tabelle ist gut gefüllt, ich rufe sie mit SetDocumentSaveToNames auf.
Nur, dass sie das nicht berücksichtigt.
Die SavePackAndGo-Funktion funktioniert nicht.
Vielen Dank im Voraus für Ihre Antworten.
Sub main()
Dim swApp als SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swPackAndGo als PackAndGo
Dim statusArray als Variante
Status dimmen: Als boolescher Wert
Status als boolescher Wert dimmen
Dim arraySource() als String
Dim arrayResult() als Zeichenkette
Dim i As Long, j As Long
Dim searchString als Zeichenfolge
SonnennummerAls Zeichenfolge suchen
Dim-Zählung So lange
Ergebnis als Zeichenfolge dimmen
Dim-ZählerOF As Collection
Dim numeroOF als Variante
Dim RultatOF Als String
Dim filesArray() als Zeichenkette
Dim ListeOF() als Zeichenkette
' 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 = Falsch
Debug.Print " Zeichnungen einschließen: " & swPackAndGo.IncludeDrawings
swPackAndGo.IncludeSimulationResults = Falsch
Debug.Print " SOLIDWORKS Simulationsergebnisse einschließen: " & swPackAndGo.IncludeSimulationResults
swPackAndGo.IncludeToolboxComponents = Falsch
Debug.Print " SOLIDWORKS Toolbox Komponenten einschließen: " & 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)
Ende Sub
Funktion GetFileName(Pfad als Zeichenfolge) als Zeichenkette
GetFileName = Right(Pfad, Len(Pfad) - InStrRev(Pfad, ""))
Ende-Funktion
PackAndGo.zip (1,1 MB)
MTD-PackAndGo-teste.swp (40.5 KB)
