MACRO die te snel loopt

Out of category
1

Hallo

Ik heb een macro gemaakt waarmee we kunnen exporteren naar PDF3D en STEP
Om de RWZI te beheren, moeten we een DEEL aan de buitenkant doornemen.

Soms gaat het ONDERDEEL niet open, de STAP wordt gegenereerd met het actieve document, dus de assemblage als het onderdeel niet wordt geopend.
Als ik de macro een tweede keer opnieuw opstart (soms heb ik + nodig), gaat het DEEL open en gaat alles zoals het hoort.

Kan het komen door de snelheid van uitvoering van de macro?
Kunnen we controleren of het PART open is voordat we het opslaan in RWZI?
Of een wachttijd toevoegen?

Fijne dag

2

U kunt de naam van de kamer eerder ophalen om er zeker van te zijn dat de kamer open is, en als de naam niet overeenkomt met uw verzoek, herhaalt u zich om de naam opnieuw te vragen en zolang deze niet goed is, exporteert u niet.

Plaats de volledige code om het gemakkelijker te zien.

Het kan ook de methode zijn om uw kamer te openen die niet de juiste is.

3

Ik kan niet hechten...
Controleer Point Infinity Volgend blokkeringsbericht

En venster waarin dit bericht verschijnt:
Er is een HTTP 0-fout opgetreden. <br />/filefield/ahah/answer/field_attachement/0

BEWERKEN:
Eindelijk is het goed... Ik had moeite om de pyjama te plaatsen


macro.txt
4

Ter info: om de code te plaatsen, heb je hier het pictogram:

En in taal zet je VBscript

1 like
5

Hallo @SebJo,

Zou het probleem te maken kunnen hebben met een misverstand over het pad voor het opslaan van bestanden?
De waarde van de variabele DestinationFolderName wordt niet gebruikt bij het maken van back-ups van bestanden. De standaardmap is de bestemming.

In mijn eerste test werd het Essai.SLDASM_1.SLDPRT-bestand opgeslagen in een submap voor de SW-installatie en niet in de basissjabloonmap. Vreemd genoeg werkt het goed als je de macro opnieuw start.

Aan het einde van de macro voegt u eenvoudig het pad en de bestandsnaam samen in de drie back-ups: DestinationFolderName & FileName***.

Vriendelijke groeten

2 likes
6

 

Ik heb net gekeken en dezelfde fout als @m.blt  de regel om DestinationFolderName te maken is te laag en de waarde wordt gevraagd voordat de variabele wordt toegewezen .

Daarnaast bevat de bestandsnaam bij het exporteren al een extensie, dus je exporteert iets als dit:

A.sldprt en de opname werkt dus niet:

De code is gecorrigeerd in de hoop dat uw fout daar vandaan kwam:

' ******************************************************************************
' macro du 19/04/22 by sj
' ******************************************************************************

Sub main()

Dim swApp                   As SldWorks.SldWorks
Dim swModel                 As SldWorks.ModelDoc2
Dim swModelDocExt           As SldWorks.ModelDocExtension
Dim swCustProp              As CustomPropertyManager
Dim val                     As String
Dim valout                  As String
Dim bool                    As Boolean
Dim INDICE                  As Boolean
Dim swExportData            As SldWorks.ExportPdfData
Dim boolstatus              As Boolean
Dim filename                As String
Dim FileNamePDF             As String
Dim FileNamePART            As String
Dim FileNameSTEP            As String
Dim lErrors                 As Long
Dim lWarnings               As Long
Dim ActiveConfig            As String
Dim sModelFullPath          As String
Dim sFilePath               As String
Dim NomDossierDestination   As String
Dim Ext_PART                As String
Dim Ext_STEP                As String
Dim errors                  As Long
Dim warnings                As Long
Dim Nomfichier              As String
Dim TestStr                 As String

Ext_PART = ".SLDPRT"
Ext_STEP = ".STEP"

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
'Controle si un PART ou un ASM est ouvert
    If swModel Is Nothing Then
        MsgBox "Aucun assemblage ou pièce en cours", vbCritical
        End
    End If
    
    If swModel.GetType <> swDocASSEMBLY And swModel.GetType <> swDocPART Then
        MsgBox "Cette Macro ne fonctionne que sur les assemblages ou les pièces", vbCritical
        End
    End If
    Set swModelDocExt = swModel.Extension
    Set swExportData = swApp.GetExportFileData(1)
    
    swExportData.ExportAs3D = True
    
'Controle si le fichier ouvert a déjà été sauvegardé
    filename = swModel.GetPathName
    If filename = "" Then
        MsgBox "Sauvegarder d'abord le fichier et réessayez", vbCritical
        End
    End If

    ActiveConfig = swApp.GetActiveConfigurationName(filename)
    
' Recuperation de propriete (changer la valeur entre "" apres Get4 pour changer de propriete à  récupérer)
    Set swCustProp = swModelDocExt.CustomPropertyManager("")
    bool = swCustProp.Get4("DESIGNATION", False, val, valout)
    PropDESIGNATION = valout
    
'Controle si le fichier ouvert a déjà  été approuvé
   PropINDICE = InputBox("A quel indice souhaitez vous générer les fichiers ?")

   If PropINDICE = "" Then
       MsgBox "Merci de ne pas laisser le champs vide", vbCritical
       Exit Sub
    End If
        
                    
'Controle si le fichier ouvert a déjà  été smarté
    If PropDESIGNATION = "" Then
        MsgBox "SMARTER votre fichier avant d'exécuter la MACRO", vbCritical
        End
    End If

    sModelFullPath = swModel.GetPathName
    sFilePath = Left(sModelFullPath, InStrRev(sModelFullPath, "\"))

'variable remonté car déclaré en dessous la 1ère utilisation de la variable dans ta version
NomDossierDestination = sFilePath
 
    
'Vérifie que le fichier PDF n'existe pas à cet indice avant enregistrement
    FileNamePDF = NomDossierDestination & PropDESIGNATION & "_" & PropINDICE & ".PDF"
    TestStr = ""
    On Error Resume Next
    TestStr = Dir(FileNamePDF)
    On Error GoTo 0
    If TestStr = "" Then
    Else
        MsgBox "Le fichier PDF existe déjà  à  cet indice " & vbCrLf & "dans le dossier de l'assemblage : " & vbCrLf & vbCrLf & sFilePath, vbCritical
        Exit Sub
    End If
    
    
'Vérifie que le fichier PART n'existe pas à cet indice avant enregistrement
    FileNamePART = NomDossierDestination & (Left(swModel.GetTitle, Len(swModel.GetTitle) - 7)) & "_" & PropINDICE & Ext_PART
    TestStr = ""
    On Error Resume Next
    TestStr = Dir(FileNamePART)
    On Error GoTo 0
    If TestStr = "" Then
    Else
        MsgBox "Le fichier PART existe déjà à cet indice" & vbCrLf & "dans le dossier de l'assemblage : " & vbCrLf & vbCrLf & sFilePath, vbCritical
        Exit Sub
    End If
    
    
'Vérifie que le fichier STEP n'existe pas à cet indice avant enregistrement
    FileNameSTEP = NomDossierDestination & PropDESIGNATION & "_" & PropINDICE & Ext_STEP
    TestStr = ""
    On Error Resume Next
    TestStr = Dir(FileNameSTEP)
    On Error GoTo 0
    If TestStr = "" Then
    Else
        MsgBox "Le fichier STEP existe déjà  à  cet indice" & vbCrLf & "dans le dossier de l'assemblage : " & vbCrLf & vbCrLf & sFilePath, vbCritical
        Exit Sub
    End If
    
    
'Enregistrer le doc actif en PDF
    swModel.ForceRebuild3 True
    swModel.ShowNamedView2 "*Isometric", -1
    swModel.ViewZoomtofit2
    boolstatus = swModelDocExt.SaveAs(FileNamePDF, 0, 0, swExportData, lErrors, lWarnings)

'Enregistrer le doc actif en PART
    Set Part = swApp.ActiveDoc
    longstatus = Part.SaveAs3(FileNamePART, 0, 0)
    
'Ouvrir le doc précédent / Enregistrer le doc actif en STEP
    Set swPart = swApp.OpenDoc6(FileNamePART, 1, 0, "", errors, warnings)
    Set Part = swApp.ActiveDoc
    longstatus = Part.SaveAs3(FileNameSTEP, 0, 0)
           
'Message d'avertissement d'execution de la macro
    MsgBox "MACRO TERMINEE :" & vbCrLf & "Contrôler les fichiers PDF3D, PART, STEP", vbInformation

End Sub

 

1 like
7

Het recordpad is de map van het huidige document
En niet de standaard directory , tenzij ik het mis heb

__

Het is verrassend, want thuis krijgt de swModel.GetTitle de extensie niet
Dus, voor het DEEL, geeft de macro dit

 

8

Ik denk dat het komt omdat de bestandsextensie is verborgen in Windows, wat niet mijn geval is.

Voor het pad van de map ging ik een paar regels omhoog (zie code en opmerking hierboven) anders de

DestinationFolderName = sFilePath

werd hieronder gevonden: van:
FileNamePDF = DestinationFolderName & PropDesignation & "_" & PropCLUE & ".PDF"
en van:
FileNamePART = DestinationFolderName & (Links(swModel.GetTitle, Len(swModel.GetTitle) - 7)) & "_" & PropHINT & Ext_PART

Dus bij de 1e lancering van de macro is het pad = een "" of niets.

Aan de andere kant, elke volgende lancering neemt het de waarde aan die het krijgt een volgende regel.

Sluit gewoon SW en start uw macro stap voor stap opnieuw en kijk naar de waarden van uw variabele in het venster en u zult het probleem zien.

9

Bedankt voor je hulp!
Alles lijkt goed te gaan