Noodzaak om PDF-macro te bewerken

Jaxx · 17 september 2020 om 12:16

Hoi allemaal

Ik heb een macro op het forum om mijn Solidworks Europarlementariërs op te slaan in PDF, mijn probleem is dat de macro de naam van de PDF verandert en dat zou ik niet leuk vinden.

Ik heb de regels die ik niet nodig heb al verwijderd, maar het is nog niet goed...

Kan iemand alstublieft de macro aan te passen zodat de bestandsnaam blijft zoals de MEP, ik zou graag de 2 opslaglocaties willen behouden.

De macro:

' We definiëren de noodzakelijke variabelen
Dim swApp als object
Dim swModel als SldWorks.ModelDoc2
Dim swCustProp als CustomPropertyManager
Dim valOut1 als snaar
Dim valOut2 als snaar
Dim valOut3 als snaar
Dim opgelostValOut1 als tekenreeks
Dim opgelostValOut2 als tekenreeks
Dim opgelostValOut3 als string
Dim pad als snaar
Dim PathDesktop als tekenreeks
Dim swModelDocExt als SldWorks.ModelDocExtension
Dim swExportPDFData As SldWorks.ExportPdfData
Dim nFileName als tekenreeks
Dim nFileName2 als tekenreeks
Dim boolstatus als Booleaanse
Dim lErrors zo lang
Dim lWaarschuwingen zo lang mogelijk
Dim lgFile als geheel getal

Sub hoofd()
'We klampen ons vast aan Solidworks
Stel swApp = Toepassing.SldWorks in

' We halen het actieve document op in Solidworks
Stel swModel = swApp.ActiveDoc in

' We controleren of een document open staat in Solidworks
Als swModel niets is, dan
MsgBox "Een document moet actief zijn in Solidworks.", vbCritical
Einde
Einde als

' We verifiëren dat het document dat in Solidworks is geopend een plan is
Als swModel.GetType <> swDocDRAWING Dan
MsgBox "Het actieve document in Solidworks moet een plan zijn.", vbCritical
Einde
Einde als

' We controleren of de open plan in Solidworks is opgeslagen
Als swModel.GetPathName = "" Dan
swModel.Opslaan
Einde als

' We halen het pad van de planregistratiemap op
Pad = swModel.GetPathName
lgFile = InStrRev(Pad, "\", -1, vbTextCompare) - 1
Als lgFile > 0 Dan
Pad = Links (Pad, lgFile)
Einde als

' We herstellen het pad van het Windows-bureaublad
PathDesktop = Over ("GEBRUIKERSPROFIEL") & "\Desktop"

' We definiëren de exportparameters in PDF
Stel swModelDocExt = swModel.Extension in
Stel swExportPDFData = swApp.GetExportFileData(1) in
swExportPDFData.ViewPdfAfterSaving = Onwaar

' We definiëren het pad en de naam van het eerste pdf-bestand dat moet worden gemaakt
nFileName = Pad & "\" & resolvedValOut1 & " - " & resolvedValOut2 & " - Ind." & resolvedValOut3 & " - " & dateNow & ".PDF"

' Sla het eerste pdf-bestand op
boolstatus = swModelDocExt.SaveAs(nFileName, 0, 0, swExportPDFData, lErrors, lWarnings)

' We definiëren het pad en de naam van het tweede pdf-bestand dat moet worden gemaakt
nFileName2 = PathDesktop & "\" & resolvedValOut1 & " - " & resolvedValOut2 & " - Ind." & resolvedValOut3 & " - " & dateNow & ".PDF"

' We slaan het tweede pdf-bestand op
boolstatus = swModelDocExt.SaveAs(nFileName2, 0, 0, swExportPDFData, lErrors, lWarnings)

Einde Sub

Bij voorbaat dank.

OBI_WAN · 17 september 2020 om 12:34

Hallo, test deze.

Kleine precisie, de PDF en DWG worden op dezelfde plaats van de laatste opname opgeslagen. In gewoon Nederlands, voordat u de Marco uitvoert, slaat u uw plan op door file=> opslaan als te doen en vervolgens de macro uit te voeren

Moge de kracht met je zijn

macro_pdf_-dwg.swp

sbadenis · 17 september 2020 om 13:02

Je mist natuurlijk niet veel, voeg gewoon een debug.print toe om de waarden van je variabelen te zien:

' On définit les variables nécessaires
Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim swCustProp As CustomPropertyManager
Dim valOut1 As String
Dim valOut2 As String
Dim valOut3 As String
Dim resolvedValOut1 As String
Dim resolvedValOut2 As String
Dim resolvedValOut3 As String
Dim Path As String
Dim PathDesktop As String
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportPDFData As SldWorks.ExportPdfData
Dim nFileName As String
Dim nFileName2 As String
Dim boolstatus As Boolean
Dim lErrors As Long
Dim lWarnings As Long
Dim lgFichier As Integer

Sub main()
' On se raccroche à Solidworks
Set swApp = Application.SldWorks

' On récupère le document actif dans Solidworks
Set swModel = swApp.ActiveDoc

' On vérifie qu'un document est bien ouvert dans Solidworks
If swModel Is Nothing Then
    MsgBox "Un document doit être actif dans Solidworks.", vbCritical
    End
End If

' On vérifie que le document ouvert dans Solidworks est un plan
If swModel.GetType <> swDocDRAWING Then
    MsgBox "Le document actif dans Solidworks doit être un plan.", vbCritical
    End
End If

' On vérifie que le plan ouvert dans Solidworks est bien enregistré
If swModel.GetPathName = "" Then
    swModel.Save
End If

' On récupère le chemin du dossier d'enregistrement du plan
Path = swModel.GetPathName
lgFichier = InStrRev(Path, "\", -1, vbTextCompare) - 1
If lgFichier > 0 Then
    Path = Left(Path, lgFichier)
End If

' On récupère le chemin du bureau Windows
PathDesktop = Environ("USERPROFILE") & "\Desktop"

' On définit les paramètres d'export en PDF
Set swModelDocExt = swModel.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.ViewPdfAfterSaving = False

' On définit le chemin et le nom du premier fichier pdf à créer
nFileName = Path & "\" & resolvedValOut1 & " - " & resolvedValOut2 & " - Ind." & resolvedValOut3 & " - " & dateNow & ".PDF"
Debug.Print "nFileName=" & nFileName

' On sauvegarde le premier fichier pdf
boolstatus = swModelDocExt.SaveAs(nFileName, 0, 0, swExportPDFData, lErrors, lWarnings)

' On définit le chemin et le nom du deuxième fichier pdf à créer
nFileName2 = PathDesktop & "\" & resolvedValOut1 & " - " & resolvedValOut2 & " - Ind." & resolvedValOut3 & " - " & dateNow & ".PDF"
Debug.Print "nFileName2=" & nFileName2

' On sauvegarde le deuxième fichier pdf
boolstatus = swModelDocExt.SaveAs(nFileName2, 0, 0, swExportPDFData, lErrors, lWarnings)

End Sub

Dan bewerk je je macro, je voegt het uitvoeringsvenster toe, je voert je macro uit en je kijkt naar de waarde van je eigendom en je zult zien of er een fout in je pad zit (voor mij zit het probleem in de aaneenschakeling van je variabele Bestandsnaam1 en 2)

Als de waarde van uw variabele niet goed is of verboden tekens bevat, wordt deze niet geregistreerd.

Daarnaast gebruik je in je aaneenschakeling resolvedValOut1, 2 en 3 variabelen, gedeclareerd zoals ze in string zouden moeten zijn, maar die niet in je macro voorkomen, dus leeg!

Cyril_f · 17 september 2020 om 13:24

Hallo

Van wat ik de behoefte begrijp, denk ik dat de onderstaande code eraan voldoet.

' On définit les variables nécessaires
Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim swCustProp As CustomPropertyManager
Dim valOut1 As String
Dim valOut2 As String
Dim valOut3 As String
Dim resolvedValOut1 As String
Dim resolvedValOut2 As String
Dim resolvedValOut3 As String
Dim Path As String
Dim PathDesktop As String
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportPDFData As SldWorks.ExportPdfData
Dim nFileName As String
Dim nFileName2 As String
Dim boolstatus As Boolean
Dim lErrors As Long
Dim lWarnings As Long
Dim lgFichier As Integer

Sub main()
' On se raccroche à Solidworks
Set swApp = Application.SldWorks

' On récupère le document actif dans Solidworks
Set swModel = swApp.ActiveDoc

' On vérifie qu'un document est bien ouvert dans Solidworks
If swModel Is Nothing Then
    MsgBox "Un document doit être actif dans Solidworks.", vbCritical
    End
End If

' On vérifie que le document ouvert dans Solidworks est un plan
If swModel.GetType <> swDocDRAWING Then
    MsgBox "Le document actif dans Solidworks doit être un plan.", vbCritical
    End
End If

' On vérifie que le plan ouvert dans Solidworks est bien enregistré
If swModel.GetPathName = "" Then
    swModel.Save
End If

' On récupère le chemin du dossier d'enregistrement du plan
Path = swModel.GetPathName
lgFichier = InStrRev(Path, "\", -1, vbTextCompare) - 1
If lgFichier > 0 Then
    Path = Left(Path, lgFichier)
End If

' On récupère le chemin du bureau Windows
PathDesktop = Environ("USERPROFILE") & "\Desktop"

' On définit les paramètres d'export en PDF
Set swModelDocExt = swModel.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.ViewPdfAfterSaving = False

' On définit le chemin et le nom du premier fichier pdf à créer
nFileName = left(Path, len(Path)-6) & "PDF" 'Retrait de l'extension SW en gardant le point et ajout PDF

' On sauvegarde le premier fichier pdf
boolstatus = swModelDocExt.SaveAs(nFileName, 0, 0, swExportPDFData, lErrors, lWarnings)

' On définit le chemin et le nom du deuxième fichier pdf à créer
nFileName2 = Mid(Path, InStrRev(Path, "\") + 1) 'purge le chemin d'accès du fichier d'origine
nFileName2 = PathDesktop & left(nFileName2, len(nFileName2)-6) & "PDF"

' On sauvegarde le deuxième fichier pdf
boolstatus = swModelDocExt.SaveAs(nFileName2, 0, 0, swExportPDFData, lErrors, lWarnings)

End Sub

Jaxx · 17 september 2020 om 14:36

@ OBI WAN
Bedankt voor de macro, ik zal het onder mijn riem houden.

@Cyril.f

Macro werkt niet :-(

@ Sbadenis

"Daarnaast gebruik je in je aaneenschakeling variabelen resolvedValOut1, 2 en 3, gedeclareerd zoals het in string zou moeten zijn, maar die niet in je macro worden gevonden, dus leeg!"

Ja, de variabelen zijn niet nuttig voor mij, ik had de functies in de macro hierboven verwijderd, maar liet die, omdat ik niet wist wat ik moest vervangen om op te slaan met dezelfde naam als mijn MAP.

Maar ineens werkt je macro ook niet meer.

Centor · 17 september 2020 om 15:42

Hallo

Ik heb een functionele macro om de tekeningen in PDF te maken

Ik stuur het je op, het draait momenteel op solidworks 2016

Ik laat je het aanpassen als dat nodig is

enregistrement_pdf.swp

sbadenis · 17 september 2020 om 15:34

Als je debug.print zet en je kijkt naar de waarden, dan had je de fout van @Cyril.f kunnen vinden door een beetje te zoeken.

Hier is de functionele code met de debug.print, kijk naar hoe het eruit ziet in het uitvoeringsvenster, dan als je wilt kun je ze becommentariëren of niet, omdat het niet echt zwaar is voor een kleine macro als deze.

' On définit les variables nécessaires
Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim Path As String
Dim PathDesktop As String
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportPDFData As SldWorks.ExportPdfData
Dim nFileName As String
Dim nFileName2 As String
Dim FileName As String
Dim boolstatus As Boolean
Dim lErrors As Long
Dim lWarnings As Long

'Dim lgFichier As Integer

Sub main()
' On se raccroche à Solidworks
Set swApp = Application.SldWorks

' On récupère le document actif dans Solidworks
Set swModel = swApp.ActiveDoc

' On vérifie qu'un document est bien ouvert dans Solidworks
If swModel Is Nothing Then
    MsgBox "Un document doit être actif dans Solidworks.", vbCritical
    End
End If

' On vérifie que le document ouvert dans Solidworks est un plan
If swModel.GetType <> swDocDRAWING Then
    MsgBox "Le document actif dans Solidworks doit être un plan.", vbCritical
    End
End If

' On vérifie que le plan ouvert dans Solidworks est bien enregistré
If swModel.GetPathName = "" Then
    swModel.Save
End If

' On récupère le chemin du dossier d'enregistrement du plan
Path = swModel.GetPathName

    
'on récupère le chemin complet sans le nom de fichier
FilePath = Left(Path, InStrRev(Path, "\"))
'Debug.Print "Filepath:" + Filepath
    
        
'on récupère le nom du fichier sans l'extension
FileName = Mid(Path, Len(FilePath) + 1, Len(Path) - (7 + Len(FilePath)))
' on affiche la variable dans la fenêtre Exécution
Debug.Print "FileName=" & FileName

' on affiche la variable dans la fenêtre Exécution
Debug.Print "Path=" & Path
lgFichier = InStrRev(Path, "\", -1, vbTextCompare) - 1
If lgFichier > 0 Then
    Path = Left(Path, lgFichier)
End If

' On récupère le chemin du bureau Windows
PathDesktop = Environ("USERPROFILE") & "\Desktop"
' on affiche la variable dans la fenêtre Exécution
Debug.Print "PathDesktop=" & PathDesktop

' On définit les paramètres d'export en PDF
Set swModelDocExt = swModel.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.ViewPdfAfterSaving = False

' On définit le chemin et le nom du premier fichier pdf à créer
'nFileName = Left(Path, Len(Path) - 6) & "PDF" 'Retrait de l'extension SW en gardant le point et ajout PDF
nFileName = FilePath & FileName & ".pdf"

' on affiche la variable dans la fenêtre Exécution
Debug.Print "nFileName=" & nFileName
' On sauvegarde le premier fichier pdf
boolstatus = swModelDocExt.SaveAs(nFileName, 0, 0, swExportPDFData, lErrors, lWarnings)

' On définit le chemin et le nom du deuxième fichier pdf à créer
'nFileName2 = PathDesktop & Left(nFileName2, Len(nFileName2) - 6) & "PDF"
nFileName2 = PathDesktop & "\" & FileName & ".pdf"
' on affiche la variable dans la fenêtre Exécution
Debug.Print "nFileName2=" & nFileName2
' On sauvegarde le deuxième fichier pdf
boolstatus = swModelDocExt.SaveAs(nFileName2, 0, 0, swExportPDFData, lErrors, lWarnings)

End Sub

Jaxx · 18 september 2020 om 05:50

@sbadenis

De macro is ook perfect, heel erg bedankt!

DAO_BRETAGNE · 31 oktober 2023 om 10:38

Hallo, kunt u mij alstublieft deze macro sturen?

sbadenis · 31 oktober 2023 om 10:52

De code voor de macro is beschikbaar in het bericht dat het onderwerp heeft opgelost.
Maak gewoon een nieuwe macro en plak de code erin.

Maak indien nodig een onderwerp opnieuw aan (met het gerelateerde onderwerp) in plaats van een oud onderwerp op te graven.