Ik nam deze macro op het net om mijn tekeningen direct op te slaan in pdf. Helaas weet ik als beginner in het veld niet hoe ik het pad aan de recordmap van mijn tekeningen moet toevoegen.
Kan iemand mij vertellen hoe ik verder moet gaan?
Hier is de macro die ik heb gevonden als het helpt, het werkt, maar slaat PDF's op in dezelfde map als mijn SW-tekeningen.
Bij voorbaat dank!
Vriendelijke groeten
Dim swApp als object Sub hoofd() Dim swApp als SldWorks.SldWorks Dim swModel als SldWorks.ModelDoc2 Dim swExportPDFData As SldWorks.ExportPdfData Dim strFilename als tekenreeks Dim status Als Booleaans Dim fouten zo lang, waarschuwingen zo lang Stel swApp = Toepassing.SldWorks in Stel swModel = swApp.ActiveDoc in 'Opslaan status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, fouten, waarschuwingen) 'Exporteer naar PDF als het een tekening is Als (swModel.GetType = swDocDRAWING) Dan strFilename = swModel.GetPathName strFilename = Links(strBestandsnaam, Len(strBestandsnaam) - 6) & "pdf" Stel swExportPDFData = swApp.GetExportFileData(1) in swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0 Einde als Einde Sub
Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename = Mid(strFilename, InStrRev(strFilename, "\") + 1) 'Purge le chemin d'accès
strFilename = Environ("userprofile") & "\Desktop\" & strFilename 'Ajoute le bureau comme chemin en remplaçement (A modifier si besoin Ex: strFilename ="C:\Temp\strFilename
strFilename = Left(strFilename, Len(strFilename) - 6) & « pdf »
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub
Het pad bevindt zich in een map die is gewijd aan het plan in PDF, die verschilt van die in SW-formaat. Maar na verloop van tijd zal de locatie veranderen omdat ik in mappen van 1000 plannen werk en het gaat heel snel. (map in een dedicated server)
Ik weet ook niet zeker of ik begreep wat ik moest doen in de @sbadenis macro en waar ik mijn pad moest toevoegen
Het pad was al hard toegevoegd (aan het bureaublad) Hoe wil je macro gebruiken? Geval nr. 1 bestand voor bestand vraagt de macro u of u uw bestand in elk bestand wilt opslaan (wat snel hoofdpijn kan zijn als u 100 bestanden moet opslaan) Geval nr. 2 in een subdirectory van uw dossier (altijd identiek) Geval nr. 3 (degene die ik had gekozen) op het bureaublad (voeg indien nodig Kaarten / toe achter het bureaublad om een map op het bureaublad te hebben).
Ik heb een PDF-tekenmap en binnenin heb ik verschillende mappen gerangschikt in stappen van 1000 pdf-plannen.
Voorbeeld:
1-1000
1001-2000
2001-3000
Ik denk dat ik ga om de macro knop te zetten in mijn werkbalk en het zal opslaan op de locatie die ik heb gekozen en ik zal het daarna veranderen.
Ik hoef alleen maar het pad naar kantoor te vervangen door het pad dat ik wil, als ik het goed begrijp, zal ik het proberen. Mijn huidige pad is als volgt: O:\SolidWorks Database\03-PDF-bibliotheek\18001-19000
strFilename = Environ("userprofile") & "\Desktop\" & strFilename 'Ajoute le bureau comme chemin en remplaçement (A modifier si besoin Ex: strFilename ="C:\Temp\strFilename
Door ''' strFilename = "O:\SolidWorks Base\03-PDF Library\18001-19000" & strFilename
Et le jour ou tu aura dépassé tes 1000 tu changes de nouveau cette ligne dans la macro
Inderdaad, er was een fout er ontbrak een \ na 19000, hier is de code gewijzigd en compleet en getest:
Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename = Mid(strFilename, InStrRev(strFilename, "\") + 1) 'Purge le chemin d'accès
strFilename = "O:\Base SolidWorks\03-Bibliothèque PDF\18001-19000\" & strFilename
strFilename = Left(strFilename, Len(strFilename) - 6) & "pdf"
Debug.Print strFilename
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub
U moet ook de map 18001-19000 al hebben voordat u de macro start
Uit nieuwsgierigheid, zou het complex zijn om automatisch het juiste bestand naar de macro te vinden wanneer ik de mijlpaal van de plannummers ben gepasseerd?
U krijgt de 2 1e cijfers en wij wijzigen de naam van de map dienovereenkomstig. Het zou een paar regels code toevoegen, maar niets bijzonders. Aan de andere kant moet u het bestand ook maken als het niet bestaat.
Nee, voor mij is het mogelijk via macro, maar het zou een paar regels code toevoegen en je moet er zeker van zijn dat de bestandsnaam van de MEP ook wordt opgenomen in de waarden die door de map worden aangegeven (bijvoorbeeld 18001.slddrw-> map 18001-19000) Kun je als voorbeeld de exacte naam van een tekening geven? Omdat het idee zou zijn om via macro het 1e cijfer op te halen en deze cijfers te volgen om op te slaan in de bestaande map of om de map te maken als we naar de volgende duizend gaan.
Hier is de gewijzigde code voor het automatisch aanmaken van de mapnaam als de MEps inderdaad in deze vorm zijn: 18001.slddrw, 19000.slddrw of 20000.slddrw...
Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim FolderName As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename = Mid(strFilename, InStrRev(strFilename, "\") + 1) 'Purge le chemin d'accès
FolderName = Left(strFilename, Len(strFilename) - 7)
Debug.Print Right(FolderName, Len(FolderName) - 2)
If Right(FolderName, Len(FolderName) - 2) = "000" Then
'Si la MEP se termine par 000 on créer le dossier avec avec comme début de N° FolderName-1
FolderName = (Left(FolderName, Len(FolderName) - 3) - 1) & "001-" & (Left(FolderName, Len(FolderName) - 3)) & "000"
Else
'Si la MEP ne se termine pas par 000 on créer le dossier avec comme début de N° FolderName
FolderName = Left(FolderName, Len(FolderName) - 3) & "001-" & (Left(FolderName, Len(FolderName) - 3) + 1) & "000"
End If
FolderName = "O:\Base SolidWorks\03-Bibliothèque PDF\" & FolderName & "\"
'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
If Dir(FolderName, vbDirectory + vbHidden) = "" Then
MkDir FolderName
End If
strFilename = FolderName & strFilename
strFilename = Left(strFilename, Len(strFilename) - 6) & "pdf"
Debug.Print strFilename
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub
