Hallo
Ich bin auf der Suche nach einem Makro (oder einem VBA-Programm), das seit einer SolidWorks-Zeichnung Folgendes tun würde:
Der Plan beginnt mit P, oder?
Oki, ich gehe raus...; -)
Gute Bemerkung @max59, also eher:
Speichern von Blättern mit der Syntax "PXX" in DWG (R12-Version)
XX besteht aus 2 Ziffern
Ist es sinnvoll, jede PXX-Seite in eine separate Datei pro Seite zu exportieren?
@MaD:
Jede PXX-Seite muss eine separate Datei sein.
Auf jeder dieser Seiten ist eine Darstellung eines Plasmaschneidkörpers zu sehen.
Ich möchte als Dateinamen angeben: MEP FILE NAME-SHEET NAME
Was das PDF-Speichern der "Plan_"-Blätter betrifft, sollten idealerweise alle Blätter in derselben PDF-Datei zusammengefasst werden.
Für PDF-Dateiname: MEP-Description-Dateiname (benutzerdefinierte Eigenschaft in der Teiledatei)
Okay, ich habe diesen Code zum Kopieren
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
Probieren Sie es zuerst an einer Kopie eines Plans aus, man weiß nie und sagen Sie mir, ob es passt
Kleiner Zusatz zum Umbenennen von DWGs
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
Ich lasse Sie es wieder in den vorherigen Code einfügen:)
und für den Namen des PDFs
Dim swCustProp As CustomPropertyManager
Set swCustProp = swModelDocExt.CustomPropertyManager("")
boolstatus = swModelDocExt.SaveAs(Filepath & "\" & Filename & "-" & swCustProp.Get("LBM_REV") & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings)
wobei LBM_REV der Name Ihrer Immobilie ist:)
Halten Sie uns auf dem Laufenden
Ich habe einen Fehler bei der Ausführung des MAKRO:
Das Ergebnis sieht wie folgt aus:
Die Eigenschaft "description" erscheint nicht im Namen der PDF-Datei
für DWGs (ich denke, es ist das Ergebnis des Fehlers), möchte ich die Namen der Blätter (P01 usw.....) am Ende anzeigen.
In der Tat, derselbe Fehler auf Ihrem neuen Makro, während Sie auf dem 1. keine Probleme haben
Ich sehe, was während meiner Tests abstürzt, es konnte nicht umbenannt werden, wenn die Datei existierte, also habe ich sie gelöscht, aber wenn sie nicht existiert, kann sie nicht gelöscht werden Ich füge ein Dateisteuerelement hinzu
Mit der Korrektur in der betreffenden Zeile
If Len(Dir(Filepath & "\" & Filename & "-" & vSheetNames(i) & ".DWG")) > 0 Then Kill Filepath & "\" & Filename & "-" & vSheetNames(i) & ".DWG"
Es sollte besser sein:)
Handelt es sich bei der Eigenschaft um eine benutzerdefinierte Eigenschaft oder um eine in Solidworks integrierte Eigenschaft?
es handelt sich um ein persönliches Eigentum ("BESCHREIBUNG") des Zimmers (Vorsicht, diese Eigenschaft ist nicht in der Zeichnung enthalten)
Ich verstehe nicht viel über VBA, aber wenn ich mir die Makros ansehe, die ich zurückbekommen habe, frage ich mich, ob es nicht dem entspricht:
Okay, ich habe sie nicht verstanden :/ ok, ich bin auf der Suche
Gibt es nur eine Komponente pro Zeichnung oder mehrere?
Nur 1 Komponente pro TGA ja
Ok, dann versuchen Sie das:)
Vielen Dank an unsere amerikanischen Freunde :) https://forum.solidworks.com/message/431752#comment-431752
Makro auf dem PC