Inpakken en wegwezen / Selecteer een bepaald bestand + hernoem

Macro
1

Hallo
Ik zit momenteel in een impasse over deze Pack And Go-code.

Specificaties:

  • Pak het pakket en ga van een vergadering /Ok voor mij/
  • Maak een lijst van alle bestanden die " OF " bevatten /Ok voor mij/
  • Bewaar alleen dat /Ok voor mij/
  • Hernoem ze met een nieuw nummer /Ok voor mij/
  • Maak mijn nieuwe Pack And Go-lijst /Ok voor mij/
  • Genereer Pack And Go // Werkt niet //

Mijn filesArray tabel is goed gevuld, ik noem het met SetDocumentSaveToNames.

Alleen houdt ze er geen rekening mee.

De SavePackAndGo-functie werkt niet.

Bij voorbaat dank voor uw antwoorden.

Sub hoofd()
Dim swApp als SldWorks.SldWorks
Dim swModel als ModelDoc2
Dim swModelDocExt als SldWorks.ModelDocExtension

Dim swPackAndGo als PackAndGo
StatusArray dimmen als variant
Dim status Als Booleaans
Statussen dimmen als Booleaans

Dim arraySource() als tekenreeks
Dim arrayResult() als tekenreeks
Dim i zo lang, j zo lang
Dim searchString Als String
Zon NummerZoeken als string
Dim telling zo lang
Dim resultaat als tekenreeks
Dim tellerOF As Collectie
Dim numeroOF Als Variant
Dim RsultatOF als snaar
Bestanden dimmenArray() als tekenreeks
dim ListeOF() als 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 = Onwaar
Debug.Print " Inclusief tekeningen: " & swPackAndGo.IncludeDrawings
swPackAndGo.IncludeSimulationResults = Onwaar
Debug.Print " Inclusief SOLIDWORKS Simulatie resultaten: " & swPackAndGo.IncludeSimulationResults
swPackAndGo.IncludeToolboxComponents = Onwaar
Debug.Print " Voeg SOLIDWORKS Toolbox-componenten toe: " & 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)

Einde Sub

Functie GetFileName(pad als tekenreeks) als tekenreeks
GetFileName = Right(pad, Len(pad) - InStrRev(pad, ""))
Functie beëindigen

PackAndGo.zip (1.1 MB)
MTD-PackAndGo-teste.swp (40.5 KB)

2

Hallo mathieu.devezeaud,

Als je " MyCadTool " hebt (we hebben myCADtools 2024 SP1 met SW 2022 SP4), is er de " projectManager " macro die prima is om bestanden in één keer te hernoemen, anders naar de mano-mano... Maar wat was er mogelijk met " PackAndGo "?
Te zien=>https://www.youtube.com/watch?v=oVhNJA6kHzY.

PackAndGo
PackAndGo1156×757 129 KB

https://www.youtube.com/watch?v=wmlU9e0Sdjs
@+.
AR.

3

Hallo

Ik denk dat er gewoon een backslash ontbreekt in deze regel: myPath = "C:\BE\1 Plans 2024\Mathieu", correct schrijven: myPath = "C:\BE\1 Plans 2024\Mathieu\"

1 like
4

Hallo Cyril,
er was inderdaad een gebrek aan een Anti-slash die een deel van het probleem oploste.
Het programma houdt geen rekening met de filesArray() array.
het maakt het pakket en gaat in de juiste bestemmingsmap, maar houdt geen rekening met de bestandenArray.
Vriendelijke groeten.

image
Afbeelding1091×148 29.5 KB

1 like
5

Hallo

Dus ik heb gewoon een beetje dieper getest. Ik heb de code enigszins gewijzigd en zou op een groter aantal bestanden moeten testen om het gedrag te controleren.
Kortom, van wat ik begrijp, heb je in de functie SetDocumentSaveToNames hetzelfde aantal " bestanden " nodig als degene die aan het begin in het pakket is geïdentificeerd en ga via GetDocumentNamesCount.
Om te testen met de onderstaande code gewijzigd:

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
    count = swPackAndGo.GetDocumentNamesCount
    ' 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(count - 1)
    myPath = "C:\temp\"
    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) = myPath & FileNames
            Debug.Print "Nouveau fichier " & filesArray(k)
            k = k + 1
            'Debug.Print FileNames
    Next

    
    
    statuses = swPackAndGo.SetDocumentSaveToNames(filesArray)
    status = swPackAndGo.SetSaveToName(True, myPath)
    statusArray = swModelDocExt.SavePackAndGo(swPackAndGo)
    

End Sub

Function GetFileName(path As String) As String
    GetFileName = Right(path, Len(path) - InStrRev(path, "\"))
End Function

De nieuwe lijnen zijn:

count = swPackAndGo.GetDocumentNamesCount

ReDim filesArray(count - 1)

filesArray(k) = myPath & FileNames
3 likes
6

Hallo

Ik zal geïnteresseerd zijn om te weten of er in uw packandgo een extern vergelijkingsbestand is.

Laat het me uitleggen, ik heb een Excel-macro waarmee ik een packandgo kan maken en mijn bestanden kan hernoemen volgens de naam van het project
Alles verloopt vlot, behalve de verwijzingslinks tussen de bestanden.
Het behoudt de links van de originele bestanden.
Bij het testen blijkt dat dit afkomstig is van het externe vergelijkingsbestand, wat een eenvoudig TXT-bestand is.

als iemand het probleem al is tegengekomen of een truc heeft voor dit probleem.

Vriendelijke groeten.

7

Bonjour

Il faudrait regarder dans cet exemple de l'API : Pack and Go Part and Linked Equation Example (VBA) - 2023 - SOLIDWORKS API Help

1 like