Hallo
Ik ben op zoek naar een macro (of een stukje VBA-programma) dat, aangezien een SolidWorks-tekening het volgende zou doen:
- PDF-opslag van bladen met namen die beginnen met "Plan_"
- DWG (R12 versie) opname van vellen die begint met "P"
Plan begint met P, toch?
Oki, ik ga uit...; -)
1 like
Goede opmerking @max59 , dus liever:
Opslaan in DWG (R12-versie) van vellen met de syntaxis "PXX"
XX is 2 cijfers
Is het gepast om elke PXX-pagina te exporteren naar een apart bestand per pagina?
1 like
@MaD:
elke PXX-pagina moet een apart bestand zijn.
Op elk van deze pagina's staat een weergave van een plasmasnijdend lichaam.
Ik wil graag als bestandsnaam opgeven: MEP BESTANDSNAAM-BLADNAAM
Wat betreft het opslaan van de "Plan_"-bladen, zouden idealiter alle bladen in dezelfde PDF moeten worden gegroepeerd.
Voor PDF-bestandsnaam: MEP-Description bestandsnaam (aangepaste eigenschap in het onderdeelbestand)
Oké, dus ik moet deze code kopiëren
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportPDFData As SldWorks.ExportPdfData
Dim boolstatus As Boolean
Dim Filename As String
Dim lErrors As Long
Dim lWarnings As Long
Dim strSheetName() As String
Dim varSheetName As Variant
'
Dim swDraw As SldWorks.DrawingDoc
Dim vSheetNames As Variant
'
Dim Part As Object
Dim longstatus As Long, longwarnings As Long
Dim File As String
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
' ajout controle du bon fichier
If Part Is Nothing Then
MsgBox "Aucun fichier n'est actuellement ouvert."
Exit Sub ' If no model is currently loaded, then exit
End If
' Determine the document type. If the document is a drawing, then send a message to the user.
If (Part.GetType <> 3) Then '1Part 2Assembly 3Document
MsgBox "Cette macro ne s'applique que sur une mise en plan"
Exit Sub
End If
File = Part.GetPathName
If File = "" Then
MsgBox "Cette macro necessite que le fichier soit préalablement enregistré"
Exit Sub
End If
Dim Filepath As String
Dim Filename As String
Filepath = Left(File, InStrRev(File, "\"))
Filename = Mid(File, Len(Filepath) + 1, Len(File) - (7 + Len(Filepath)))
Set swModelDocExt = Part.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
Set swDraw = Part
vSheetNames = swDraw.GetSheetNames
Dim i As Long
Dim j As Long
j = 0
ReDim strSheetName(UBound(vSheetNames))
For i = 0 To UBound(vSheetNames)
If InStr(vSheetNames(i), "Plan") <> 0 Then
strSheetName(j) = vSheetNames(i)
j = j + 1
End If
Next
varSheetName = strSheetName
If swExportPDFData Is Nothing Then MsgBox "Nothing"
boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, varSheetName)
swExportPDFData.ViewPdfAfterSaving = True
boolstatus = swModelDocExt.SaveAs(Filepath & "\" & Filename & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings)
'DWG
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfVersion, swDxfFormat_e.swDxfFormat_R12)
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfMultisheet_e.swDxfSeparateSheets)
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfVersion, 0)
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, 1)
longstatus = Part.SaveAs3(Filepath & "\" & Filename & ".DWG", 0, 0)
For i = 0 To UBound(vSheetNames)
If InStr(vSheetNames(i), "Plan") <> 0 Then
Kill Filepath & "\" & Format(i, String(2, "0")) & "_" & Filename & ".DWG"
End If
Next
End Sub
Probeer het eerst op een kopie van een plan, je weet maar nooit en vertel me of het past
3 likes
Kleine toevoeging om DWG's te hernoemen
If InStr(vSheetNames(i), "Plan") <> 0 Then
Kill Filepath & "\" & Format(i, String(2, "0")) & "_" & Filename & ".DWG"
Else
Kill Filepath & "\" & Filename & "-" & vSheetNames(i) & ".DWG"
Name Filepath & "\" & Format(i, String(2, "0")) & "_" & Filename & ".DWG" As Filepath & "\" & Filename & "-" & vSheetNames(i) & ".DWG"
End If
Ik laat je het terug zetten in de vorige code:)
3 likes
en voor de naam van de PDF
Dim swCustProp As CustomPropertyManager
Set swCustProp = swModelDocExt.CustomPropertyManager("")
boolstatus = swModelDocExt.SaveAs(Filepath & "\" & Filename & "-" & swCustProp.Get("LBM_REV") & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings)
waar LBM_REV de naam van uw woning is:)
Hou ons op de hoogte
3 likes
Ik heb een fout in de uitvoering van de MACRO:
Het resultaat is als volgt:
De eigenschap "description" wordt niet weergegeven in de PDF-bestandsnaam
voor DWG's, (ik denk dat het het resultaat is van de fout), wil ik de namen van de bladen (P01, enz.....) aan het einde tonen.
capture-2.jpg
2 likes
Inderdaad, dezelfde fout op uw nieuwe macro, terwijl op de 1e geen problemen
Ik zie wat er crasht tijdens mijn tests, het kon niet hernoemen als het bestand bestond, dus ik heb het verwijderd, maar als het niet bestaat, kan het het niet verwijderen, ik voeg een bestandsbesturingselement toe
2 likes
Met de correctie op de betreffende regel
If Len(Dir(Filepath & "\" & Filename & "-" & vSheetNames(i) & ".DWG")) > 0 Then Kill Filepath & "\" & Filename & "-" & vSheetNames(i) & ".DWG"
Het zou beter moeten zijn:)
macro_export_pdf__dwg.swp
2 likes
Is het voor de woning een aangepaste woning of degene die in Solidworks is geïntegreerd?
1 like
het is een persoonlijke eigenschap ("BESCHRIJVING") van de kamer (wees voorzichtig, deze eigenschap staat niet op de tekening)
Ik begrijp niet veel van VBA, maar als ik in macro's duik die ik terug heb, vraag ik me af of het niet overeenkomt met dit:
capture-4.jpg
Oké, ik begreep haar niet :/ ok, ik ben op zoek
1 like
Is er slechts één component per tekening of meerdere?
1 like
Slechts 1 component per Europarlementariër ja
Ok probeer dan dit:)
Hartelijk dank aan onze Amerikaanse vrienden :) https://forum.solidworks.com/message/431752#comment-431752
Macro op pc
macro_export_pdf__dwg.swp
5 likes