| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für SOLIDWORKS | | | | 3DEXPERIENCE Conference 2024 | München, eine Veranstaltung am 17.10.2024
|
Autor
|
Thema: Macro: Zeichnung öffnen vom Teil (1386 / mal gelesen)
|
WBCCon Mitglied Konstrukteur
Beiträge: 9 Registriert: 04.08.2021
|
erstellt am: 04. Aug. 2021 11:31 <-- editieren / zitieren --> Unities abgeben:
Hallo, ich bin neu hier und in Programmieren nicht gut:-) Mein Problem: Ich benötige ein Macro, welches mir aus einem geöffnetem Teil, die dazugehörige Zeichnung öffnet (Teil soll geöffnet bleiben). Ich habe mich an einem Vorhandenen Macro von Stefan Berlitz gewagt, dass das macht, habe da aber einige Probleme. 1. Und zwar sucht das Macro nach der Zeichnungsnummer in den Konfigurationsspezifischen Eigenschaften. Meine Daten, wie "Zeichnungsnummer" sind aber in den Benutzerdefinierten Eigenschaften gespeichert. Wie bekomme ich es geändert? 2. Zudem sucht das Macro in dem Feld "Wert/Textausdruck" (Wenn ich mich nicht täusche), wo bei mir aber eine Formel drin Steht, die die Zeichnungsnummer Evaluiert ($PRP:"SW-File Name"). Somit brauche ich eigentlich den Evaluierten Wert zum Suchen für das Macro. Wie kann ich das in dem Vorhandenen Macro ändern? Wäre schön, wenn mir da jemand weiterhelfen kann.
Code: ' ************************************************************************ ' * Makro holt sich vom aktiven Modell aus der konfigurations-spezifischen ' * Dateieigenschaft DRWNAME (unten festlegen) den Namen der passenden ' * Zeichnungsnumemr heraus und öffnet diese in SOlidWorks ' * ' * 29.04.2005 Stefan Berlitz (stefan.berlitz@solidworks.cad.de) ' * http://solidworks.cad.de ' * http://swtools.cad.de ' ********************************************************************** ' this Constants are editable to customize behaviour ' Name der konfspezifischen Dateieigenschaft, in der der Name des ' Zeichnungsdokumentes steht Const DRWNAME = "Zeichnungsnummer" '(von mir abgeändert) ' ********************************************************************** ' do not edit below this line unless you know what you are doing ;-)) Const swDocNONE = 0 Const swDocPART = 1 Const swDocASSEMBLY = 2 Const swDocDRAWING = 3 Const swOpenDocOptions_Silent = 1 Const swOpenDocOptions_ReadOnly = 2 Const swOpenDocOptions_ViewOnly = 4 Const swOpenDocOptions_RapidDraft = 8 Const swOpenDocOptions_LoadModel = 16 Const swOpenDocOptions_AutoMissingConfig = 32 Sub main() Dim swApp As Object Dim ModelDoc As Object Dim ModelPathName As String Dim ActiveConfname As String Dim DrwFileName As String Dim DrwFullPath As String Dim DrawingDoc As Object Dim errors As Long Dim warnings As Long ' an SolidWorks anklinken und aktives Assembly holen Set swApp = CreateObject("SldWorks.Application") Set ModelDoc = swApp.ActiveDoc If ModelDoc Is Nothing Then ' dann war gar kein Dokument geöffnet, wie soll da was funktionieren MsgBox "Kein Dokument aktiv" Exit Sub End If If (ModelDoc.GetType = swDocDRAWING) Then ' wenn keine Modell aktiv ist wird das Makro wieder beendet MsgBox "Nur für Modelle geeignet" Exit Sub End If ' dann den Namen der aktuellen Konfiguration raussuchen, dazu brauchen ' wir den dateinamen des aktuellen Modells ModelPathName = ModelDoc.GetPathName ActiveConfname = swApp.GetActiveConfigurationName(ModelPathName) ' damit jetzt die Dateieigenschaft auslesen, in der der Zeichnungsname drinsteht DrwFileName = ModelDoc.CustomInfo2(ActiveConfname, DRWNAME) If DrwFileName = "" Then ' dann gibt es die konfigspezifische Dateieigenschaft nicht MsgBox "Dateieigenschaft " & DRWNAME & " nicht vorhanden oder leer" Else ' sicherheitshalber ein .SLDDRW anhängen, falls nicht vorhanden If LCase(Right(DrwFileName, 7)) <> ".slddrw" Then DrwFileName = DrwFileName & ".slddrw" End If ' dann diese Datei im Ordner der Zeichnung suchen DrwFullPath = GetFullPath(ModelPathName) & "\" & DrwFileName If FileExists(DrwFullPath) Then ' dann Zeichnung öffnen Set DrawingDoc = swApp.OpenDoc6(DrwFullPath, swDocDRAWING, 0, "", errors, warnings) Else ' Datei existiert nicht MsgBox "Zeichnung " & DrwFileName & " existiert nicht im Verzeichnis." & vbCrLf & _ DrwFullPath End If End If End Sub Private Function GetFullPath(strPath As String) As String ' Dim intCounter As Integer ' rückwärts bis zum Punkt suchen For intCounter = Len(strPath) To 1 Step -1 If Mid$(strPath, intCounter, 1) = "\" Then Exit For End If Next intCounter ' und den Wert zurückgeben OHNE den Punkt GetFullPath = Left$(strPath, intCounter - 1) End Function Private Function FileExists(strDest As String) As Boolean ' checks if file strDest exists Dim intLen As Integer If strDest <> vbNullString Then On Error Resume Next intLen = Len(Dir$(strDest)) On Error GoTo 0 FileExists = (Not Err And intLen > 0) Else FileExists = False End If End Function Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
WBCCon Mitglied Konstrukteur
Beiträge: 9 Registriert: 04.08.2021
|
erstellt am: 04. Aug. 2021 11:43 <-- editieren / zitieren --> Unities abgeben:
|
Andi Beck Ehrenmitglied V.I.P. h.c. Konstrukteur
Beiträge: 2580 Registriert: 02.10.2006 Firma: SW 2024-3.1 + PDM Prof. Windows 10 Pro 64bit, i9-11900 32 GbRAM, Quadro P2200 Home: SW 2023-5.0 Passungstabelle von Heinz Windows 11 Pro 64bit, i7-12700K, 32 GbRAM, GeForce GTX 1050Ti Samsung C34H892, 3440x1440 Pixel
|
erstellt am: 04. Aug. 2021 12:20 <-- editieren / zitieren --> Unities abgeben: Nur für WBCCon
|
WBCCon Mitglied Konstrukteur
Beiträge: 9 Registriert: 04.08.2021
|
erstellt am: 04. Aug. 2021 12:51 <-- editieren / zitieren --> Unities abgeben:
Danke für die schnelle Antwort. Aber leider reichen meine Kenntnisse nicht soweit, um es abzuändern. Ich habe deine Version 1.2 genommen und versucht einige Dinge rauszunehmen, da ich nicht abhängig von den Konfigurationen sein will und nicht anklicken möchte, da nur eine Zeichnung vom Teil hinterlegt ist, und die heißt exakt genau so wie das Teil. Vieleicht kannst du mir da weiterhelfen das abzuändern.
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
dopplerm Ehrenmitglied V.I.P. h.c. Konstrukteur
Beiträge: 3627 Registriert: 11.02.2005 Win 10 SWX 2019 SP 5.0
|
erstellt am: 04. Aug. 2021 13:28 <-- editieren / zitieren --> Unities abgeben: Nur für WBCCon
vielleicht hilft dir diese Funktion weiter, in dieser ist dein gewünschtes ja eigentlich enthalten Das Teil kann ja mit einem Klick aus der Zeichnung geöffnet werden, warum ein Makro dazu? Kannst du uns vielleicht ein wenig deine Beweggründe erklären, in welchem Zusammenhang du die Funktion nutzen möchtest? Also was du vorher, bzw. nachher vor hast. Vielleicht gibt es da schon was ähnliches, was wir schon kennen, oder wo du weiter nachlesen kannst. lg Martin ------------------ ich spiel noch immer gern mit Bauklötzen, nur sind sie jetzt teurer Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
riesi Mitglied CAD-Admin
Beiträge: 1087 Registriert: 06.05.2002 SWX Premium 2023-Sp5
|
erstellt am: 04. Aug. 2021 13:32 <-- editieren / zitieren --> Unities abgeben: Nur für WBCCon
|
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2795 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 04. Aug. 2021 13:33 <-- editieren / zitieren --> Unities abgeben: Nur für WBCCon
Hallo, wenn doch die Namen von Teil und Zeichnung identisch sind wofür brauchst du dann ein Macro, dies braucht man doch nur wenn die Namen unterschiedlich sind oder eben mehrere Zeichnungen Konfigurationsabhängig vorhanden sind? Oder liegt die Zeichnung in einem anderen Pfad? Oder meinst du das die Zeichnung zwar geöffnet werden soll aber nicht in den Vordergrung soll sondern weiterhin das Part aktiv sein soll? Gruß Bernd ------------------ --- Man muß nicht alles wissen, man muß nur wissen wo es steht --- Staatlich anerkannte Deutschniete Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
WBCCon Mitglied Konstrukteur
Beiträge: 9 Registriert: 04.08.2021
|
erstellt am: 04. Aug. 2021 15:10 <-- editieren / zitieren --> Unities abgeben:
Gerne gebe ich eine kurze Beschreibung, warum das notwendig ist. Unsere Blechlieferanten, die die Laserzuschnitte machen, brauchen immer eine STEP, eine PDF-Zeichnung, eine DXF-Zeichnung und eine DXF Abwicklung. Das sind die geforderten Dateien. Also Teil öffnen, Speichern als STEP, Zeichnung öffnen und Ausgabe in PDF, DXF, DXF. Die Ausgabe der Dateien bekomme ich per Macro hin. Ob STEP Oder PDF, DXF. Da habe ich schon einiges gefunden und Eingebunden. Nun soll der ganze Ablauf etwas schneller vonstatten gehen, da bei einigen Tausend Teilen, das schon einiges an Zeit einsparen würde. Deshalb möchten wir gerne, das wir am besten die Zeichnung öffnen, sie Kontrollieren und dann das Macro ausführen, das wiederum das Teil öffnet, damit die STEP erstellt wird und das Teil wieder geschlossen wird und dann noch die PDF, DXF, DXF. Das einzige was fehlt, ist, dass ich das Teil öffnen muss. Andersrum geht der Weg natürlich auch über das Teil, das dann die Zeichnung geöfnet wird, wie oben Beschrieben. Am besten aber, dass das Teil aus der Zeichnung heraus geöffnet wird. Hoffe die Beschreibung reicht und ihr könnt mir da weiterhelfen. Die Einzelnen Marcros zusammenfügen würde ich irgendwie schaffen denke ich zumindest. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
deckelmaho Mitglied Konstrukteur
Beiträge: 240 Registriert: 03.03.2020 SolidWorks 2023 SP5 Windows 10 64bit Office 2019
|
erstellt am: 04. Aug. 2021 15:37 <-- editieren / zitieren --> Unities abgeben: Nur für WBCCon
|
WBCCon Mitglied Konstrukteur
Beiträge: 9 Registriert: 04.08.2021
|
erstellt am: 04. Aug. 2021 16:00 <-- editieren / zitieren --> Unities abgeben:
Es gibt nur ein Teil auf der Zeichnung, aber in verschiedenen Ansichten. Also sollte es nicht zu kompliziert werden. Einfach gesagt, "Blatt1" hat ca. 3 Ansichten aus einem Teil mit derselben Zeichnungsnummer. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
riesi Mitglied CAD-Admin
Beiträge: 1087 Registriert: 06.05.2002 SWX Premium 2023-Sp5
|
erstellt am: 04. Aug. 2021 16:11 <-- editieren / zitieren --> Unities abgeben: Nur für WBCCon
Die komplette Routine aus unserem Add-In in VB.NET, inkl. anschließenden zippen. Sollte für VBA mit geringen Anpassungen möglich sein. Das Speichern des PDFs musst Du dann selber hin zu fügen.
Code: Public Sub RunSolidWorks(myVault As IEdmVault21, oFile As IEdmFile17, oFolder As IEdmFolder12, Handler As Integer, LogFile As String, LogPath As String, inst As IEdmTaskInstance, SolidWorksPath As String) Try Dim swApp As SldWorks.SldWorks = SWVerify() AppActivate(swApp.GetProcessID) swApp.Visible = True Dim sDocFilename As String = oFile.GetLocalPath(oFolder.ID) Dim sFolderPath As String = oFolder.LocalPath 'Dateityp ermitteln Dim FileExtension As String FileExtension = LCase(Path.GetExtension(sDocFilename).Replace(".", "")) 'Zeichnung laden Dim swDocSpecification As SldWorks.DocumentSpecification Dim errors As Integer swDocSpecification = swApp.GetOpenDocSpec(sDocFilename) swDocSpecification.DocumentType = swDocumentTypes_e.swDocDRAWING swDocSpecification.ReadOnly = True swDocSpecification.Silent = True swDocSpecification.ConfigurationName = "" swDocSpecification.DisplayState = "" swDocSpecification.IgnoreHiddenComponents = True Dim swModel As SldWorks.ModelDoc2 swModel = swApp.OpenDoc7(swDocSpecification) errors = swDocSpecification.Error If swModel Is Nothing Then Call Log("SolidWorks konnte die Zeichnung nicht laden:" & sDocFilename, myVault, LogPath, LogFile) Call inst.SetStatus(EdmTaskStatus.EdmTaskStat_DoneFailed, 0, "SolidWorks konnte die Zeichnung nicht laden") Exit Sub End If ' DXF-Export Dim nErrors As Long Dim nWarnings As Long Dim sFileName As String sFileName = Path.GetFileNameWithoutExtension(oFile.Name) Dim sDXFName As String = exportPfad + sFileName + ".dxf" swApp.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfMapping, False) swApp.SetUserPreferenceToggle(swUserPreferenceIntegerValue_e.swDxfVersion, 5) swApp.SetUserPreferenceToggle(swUserPreferenceIntegerValue_e.swDxfOutputFonts, False) swApp.SetUserPreferenceToggle(swUserPreferenceIntegerValue_e.swDxfMappingFileIndex, False) swApp.SetUserPreferenceToggle(swUserPreferenceIntegerValue_e.swDxfOutputLineStyles, True) swApp.SetUserPreferenceToggle(swUserPreferenceIntegerValue_e.swDxfOutputNoScale, True) swApp.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDXFDontShowMap, False) swApp.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfExportSplinesAsSplines, False) Dim bRet As Boolean bRet = swModel.Extension.SaveAs(sDXFName, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, nErrors, nWarnings) If bRet = False Then Call Log("Save DXF: " & swMessageBoxIcon_e.swMbWarning, myVault, LogPath, LogFile) Call inst.SetStatus(EdmTaskStatus.EdmTaskStat_DoneFailed, 0, "Speichern des DXFs fehl geschlagen") Exit Sub End If Dim swDraw As SldWorks.DrawingDoc swDraw = swModel Dim swView As SldWorks.View swView = swDraw.GetFirstView swView = swView.GetNextView Dim swConfigMgr As SldWorks.ConfigurationManager swConfigMgr = swDraw.ConfigurationManager Dim swConfig As SldWorks.Configuration swConfig = swConfigMgr.ActiveConfiguration ' Gibt es ein Ansicht? If swDraw.GetPathName = "" Then Call Log("Suche Modell: Keine Ansicht gefunden", myVault, LogPath, LogFile) Call inst.SetStatus(EdmTaskStatus.EdmTaskStat_DoneFailed, 0, "Suche Modell: Keine Ansicht gefunden") Exit Sub End If Dim strModelName As String strModelName = swView.GetReferencedModelName Dim strConfig As String strConfig = swView.ReferencedConfiguration If strConfig = "" Then Call Log("Konnte kein 3D-Modell finden", myVault, LogPath, LogFile) Call inst.SetStatus(EdmTaskStatus.EdmTaskStat_DoneFailed, 0, "Konnte kein 3D-Modell finden") Exit Sub End If Dim swRefModel As SldWorks.ModelDoc2 swRefModel = swApp.ActivateDoc3(strModelName, True, swRebuildOnActivation_e.swDontRebuildActiveDoc, nErrors) 'open doc bRet = swRefModel.ShowConfiguration2(strConfig) 'activate config swRefModel.ViewZoomtofit2() swApp.SetCurrentWorkingDirectory(exportPfad) swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swStepAP, 214) Dim stepFileName As String stepFileName = exportPfad & Path.GetFileNameWithoutExtension(strModelName) & ".step" Dim sModelName As String = Path.GetFileNameWithoutExtension(strModelName) bRet = swRefModel.Extension.SaveAs(stepFileName, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, nErrors, nWarnings) If bRet = False Then Call Log("STEP speichern: " & swMessageBoxIcon_e.swMbWarning, myVault, LogPath, LogFile) Call inst.SetStatus(EdmTaskStatus.EdmTaskStat_DoneFailed, 0, "Fehler beim Speichern des Step") Exit Sub End If 'Alle Dokumente wieder schliessen swApp.CloseDoc(swDraw.GetTitle) 'close doc swApp.CloseDoc(swRefModel.GetTitle) 'swApp.ExitApp() ' Wir erzeugen ein ZIP Dim sZIPName As String sZIPName = exportPfad & sFileName & ".zip" Using newZIP As New FileStream(sZIPName, FileMode.Create) Using oZip As ZipArchive = New ZipArchive(newZIP, ZipArchiveMode.Create) Dim Eintrag As ZipArchiveEntry Eintrag = oZip.CreateEntryFromFile(sDXFName, sFileName + ".dxf", CompressionLevel.Optimal) Eintrag = oZip.CreateEntryFromFile(stepFileName, sModelName + ".step", CompressionLevel.Optimal) End Using End Using 'DXF und Step löschen My.Computer.FileSystem.DeleteFile(sDXFName) My.Computer.FileSystem.DeleteFile(stepFileName) Catch ex As System.Runtime.InteropServices.COMException 'Return errors to the framework by failing the task inst.SetStatus(EdmTaskStatus.EdmTaskStat_DoneFailed, ex.HResult, "Konvertieren fehlgeschlagen! " + ex.HResult.ToString) Catch ex As Exception 'Return errors to the framework by failing the task inst.SetStatus(EdmTaskStatus.EdmTaskStat_DoneFailed, ex.HResult, "Konvertieren fehlgeschlagen! " + ex.HResult.ToString) End Try End Sub
[Diese Nachricht wurde von riesi am 04. Aug. 2021 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
deckelmaho Mitglied Konstrukteur
Beiträge: 240 Registriert: 03.03.2020 SolidWorks 2023 SP5 Windows 10 64bit Office 2019
|
erstellt am: 04. Aug. 2021 21:35 <-- editieren / zitieren --> Unities abgeben: Nur für WBCCon
Ich weis ja nicht wie der Stand der Dinge in diesem Fall ist, aber solltest du trotz der Hilfestellungen nicht weiter kommen, dann würde ich dir Morgen was schreiben. Zum Ablauf: Erzeugt einen Ordner "..\EXPORT" im aktuellen Projektordner (wo die Zeichnung liegt) Aktuelles Blatt speichern als PDF und DXF. (Gespeichert mit dem aktuellen Blattnamen) Anschießend wird das Modell aus der ersten Ansicht geöffnet und als STEP speichern. (Gespeichert mit dem aktuellen Dateinamen) Fertigmeldung Nachteilig dabei ist, dass du keine Erfahrungen mit VBA und der Solidworks API sammeln kannst. LG Kevin
------------------ HOMEPAGE | SWXTools.de - SWXHelper für SOLIDWORKS KONTAKT | support@swxtools.de FACEBOOK | facebook.com/SWXHelper TWITTER | twitter.com/SWXTools Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
deckelmaho Mitglied Konstrukteur
Beiträge: 240 Registriert: 03.03.2020 SolidWorks 2023 SP5 Windows 10 64bit Office 2019
|
erstellt am: 05. Aug. 2021 08:03 <-- editieren / zitieren --> Unities abgeben: Nur für WBCCon
Guten Morgen WBCCon, (wenn das dein Name ist) ich war mal schon fleißig und habe das geschriebene von Gestern Abend schon umgesetzt. Code:
Option Explicit Dim swApp As SldWorks.SldWorks Dim swModelDoc As SldWorks.ModelDoc2 Dim swDrawingDoc As SldWorks.DrawingDoc Dim swSheet As SldWorks.Sheet Dim swExportPDFData As SldWorks.ExportPdfData Dim swView As SldWorks.ViewDim nErrors As Long Dim nWarnings As Long Dim bRet As Boolean Sub main() On Error GoTo main_Error Set swApp = Application.SldWorks Set swModelDoc = swApp.ActiveDoc 'Wenn es keine Zeichnung ist, dann Fehler und raus If swModelDoc.GetType <> swDocDRAWING Then swApp.SendMsgToUser ("Nur für Zeichnungen!") Exit Sub End If 'DrawingDoc aus ModelDoc holen Set swDrawingDoc = swModelDoc 'Das aktuelle Blatt aus dem DrawingDoc holen Set swSheet = swDrawingDoc.GetCurrentSheet 'Speicherpfad festlegen Dim SavePath As String SavePath = Left(swModelDoc.GetPathName, InStrRev(swModelDoc.GetPathName, "\") - 1) 'aktueller Projektordner SavePath = SavePath & "\EXPORT\" 'Erweitert um den Export-Ordner 'Falls es den Ordner nicht gibt wird einer Erzeugt If Dir(Left(SavePath, Len(SavePath) - 1), vbDirectory) = "" Then MkDir (Left(SavePath, Len(SavePath) - 1)) End If '-------------------------------------------------------------------------------------------------------------------------------------------------------- '____/\\\\\\\\\______/\\\\\\\\\\\\____ ' __/\\\///////\\\___\/\\\////////\\\__ ' _\///______\//\\\__\/\\\______\//\\\_ ' ___________/\\\/___\/\\\_______\/\\\_ ' ________/\\\//_____\/\\\_______\/\\\_ ' _____/\\\//________\/\\\_______\/\\\_ ' ___/\\\/___________\/\\\_______/\\\__ ' __/\\\\\\\\\\\\\\\_\/\\\\\\\\\\\\/___ ' _\///////////////__\////////////_____ '####### Einstellungen DXF ####### swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDxfMapping, False 'Gibt an, ob Mapping implementiert werden soll swApp.SetUserPreferenceToggle swUserPreferenceIntegerValue_e.swDxfVersion, 5 'DXF-Version swApp.SetUserPreferenceToggle swUserPreferenceIntegerValue_e.swDxfOutputFonts, 1 '(0 = AutoCAD STANDARD only / 1 = TrueType) swApp.SetUserPreferenceToggle swUserPreferenceIntegerValue_e.swDxfOutputLineStyles, 1 '(0 = AutoCAD Standard Styles / 1 = SolidWorks Custom Styles) swApp.SetUserPreferenceToggle swUserPreferenceIntegerValue_e.swDxfOutputNoScale, 1 '(0 = no scale / 1 = 1:1 scale) swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDXFDontShowMap, False 'Legt fest, ob beim Speichern der Zeichnung ein Dialog erscheint, wenn swDxfMapping auf True gesetzt ist swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDxfExportSplinesAsSplines, False '(True = Splines; False = Polylinien) swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfMultisheet_e.swDxfActiveSheetOnly 'Nur das aktuelle Blatt als Einzelblatt speichern '#################################
'Speichern mit aktuellen Blattnamen bRet = swModelDoc.SaveAs4(SavePath & swSheet.GetName & ".dxf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, nErrors, nWarnings) Debug.Print "DXF gespeichert?:" & bRet '####### Einstellungen PDF ####### 'Farbe für den PDF-Export ausschalten swApp.SetUserPreferenceToggle swPDFExportInColor, False 'Legt fest, ob Dokumente beim Speichern in PDF in Farbe gespeichert werden sollen swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swPDFExportEmbedFonts, True 'Legt fest, ob Schriftarten beim Speichern von Dokumenten im PDF-Format eingebettet werden sollen swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swPDFExportHighQuality, True 'Legt fest, ob Zeichnungsdokumente beim Speichern in PDF in hoher Qualität gespeichert werden sollen '################################# 'PDF Exporter vorbereiten und Blatt setzen Set swExportPDFData = swApp.GetExportFileData(1) bRet = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, swSheet.GetName) 'Speichern mit aktuellen Blattnamen bRet = swModelDoc.Extension.SaveAs(SavePath & swSheet.GetName & ".PDF", 0, 0, swExportPDFData, nErrors, nWarnings) Debug.Print "PDF gespeichert?:" & bRet '-------------------------------------------------------------------------------------------------------------------------------------------------------- ' _____/\\\\\\\\\\___/\\\\\\\\\\\\____ ' ___/\\\///////\\\_\/\\\////////\\\__ ' __\///______/\\\__\/\\\______\//\\\_ ' _________/\\\//___\/\\\_______\/\\\_ ' ________\////\\\__\/\\\_______\/\\\_ ' ___________\//\\\_\/\\\_______\/\\\_ ' __/\\\______/\\\__\/\\\_______/\\\__ ' _\///\\\\\\\\\/___\/\\\\\\\\\\\\/___ ' ___\/////////_____\////////////_____
'Erste Ansicht holen (Die erste Ansicht ist das Blatt selbst) Set swView = swDrawingDoc.GetFirstView '...also die nächste nehmen Set swView = swView.GetNextView 'Jetzt das Modell aus des aktuellen Ansicht holen Dim MyReferencedModel As ModelDoc2 Set MyReferencedModel = swView.ReferencedDocument 'Den Dateinamen des aktuellen Modells nehmen und die Endung abschneiden Dim StepFileName As String StepFileName = Left(MyReferencedModel.GetTitle, Len(MyReferencedModel.GetTitle) - 7) '####### Einstellungen STEP ####### swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swStepExportPreference, swAcisOutputGeometryPreference_e.swAcisOutputAsSolidAndSurface 'Ausgabe als - Volumen-/Flächengeometrie swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swStepExportConfigurationData, False 'Gibt an, ob STEP-Konfigurationsdaten exportiert werden sollen swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swStepExportFaceEdgeProps, False 'Legt fest, ob Flächen- und Kanteneigenschaften exportiert werden sollen swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swStepExportSplitPeriodic, False 'Gibt an, ob periodische Flächen beim Export geteilt werden sollen swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swStepExport3DCurveFeatures, False 'Gibt an, ob 3D-Kurvenfeatures in die exportierte Datei aufgenommen werden sollen. 'Step Version swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swStepAP, 214 '(203 = STEP AP203 format / 214 = STEP AP214 format) '################################# 'Speichern mit aktuellen Dateinamen bRet = MyReferencedModel.Extension.SaveAs(SavePath & StepFileName & ".step", swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, nErrors, nWarnings) Debug.Print "STEP gespeichert?:" & bRet '-------------------------------------------------------------------------------------------------------------------------------------------------------- On Error GoTo 0 Exit Sub main_Error: MsgBox "Ein Fehler ist aufgetreten, der EXPORTER wird beendet", vbOKOnly Or vbCritical, "EXPORTER" End Sub
Ich hab versucht alle Schritte und Einstellungen zu erklären, damit du diese ohne viel Kenntnisse anpassen kannst. Einfach COPY & PASTE des Codes in eine neue Makrodatei. LG Kevin ------------------ HOMEPAGE | SWXTools.de - SWXHelper für SOLIDWORKS KONTAKT | support@swxtools.de FACEBOOK | facebook.com/SWXHelper TWITTER | twitter.com/SWXTools Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
WBCCon Mitglied Konstrukteur
Beiträge: 9 Registriert: 04.08.2021
|
erstellt am: 05. Aug. 2021 08:51 <-- editieren / zitieren --> Unities abgeben:
Guten Morgen und danke für all die Mühe von euch @riesi danke für deine Mühe, aber das abändern bekomme ich leider nicht hin
@deckelmaho vielen Dank für die große Hilfe. Das macro erzeugt eine PDF und DXF des ersten Blattes wie es auch soll. leider tritt dann aber ein Fehler auf, wenn es um den Export der Step geht. Unter Rubrik 30 im Code, gibt er mir einen Fehler raus, wo er nicht weiter kommt. Nähmlich an dieser Stelle: 'Den Dateinamen des aktuellen Modells nehmen und die Endung abschneiden StepFileName = Left(MyReferencedModel.GetTitle, Len(MyReferencedModel.GetTitle) - 7) kannst du mir da weiterhelfen? Der Ansatz mit dem Erzeugen eines neuen Ordners "EXPORT" finde ich sehr gut. Vereinfacht alles. Gruß Willi Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
deckelmaho Mitglied Konstrukteur
Beiträge: 240 Registriert: 03.03.2020 SolidWorks 2023 SP5 Windows 10 64bit Office 2019
|
erstellt am: 05. Aug. 2021 09:19 <-- editieren / zitieren --> Unities abgeben: Nur für WBCCon
|
WBCCon Mitglied Konstrukteur
Beiträge: 9 Registriert: 04.08.2021
|
erstellt am: 05. Aug. 2021 09:42 <-- editieren / zitieren --> Unities abgeben:
Hi, ja, alles ist abgespeichert. Ich habe soeben den Zuschnitt des namens auf 0 gesetzt und dann packt er es. StepFileName = Left(MyReferencedModel.GetTitle, Len(MyReferencedModel.GetTitle) - 0). danke für die ganze Hilfe. Funktioniert soweit sehr gut. Bin Begeistert Kannst du vieleicht noch einige Änderungen vornehmen ohne unverschämt zu wirken. 1. Er speichert momentan das erste Blatt als PDF und DXF mit dem Namen des Blattes, also heist die PDF und DXF momentan Blatt1. Kann man den namen der PDF und DXF auch mit dem Namen der Zeichnungsnummer versehen? Bei der STEP passt es. 2. Wir haben immer 2 Blätter in der Zeichnung. das erste Blatt ist immer die Zeichnung und das zweite Blatt immer eine DXF. Vom ersten Blatt macht er eine PDF und DXF, wie es auch soll. ist es möglich auch vom zweiten Blatt eine DXF zu machen? Dann Sollte das Macro genau das machen, was ich brauche. Danke schon mal im voraus für die Ganze Mühe und Hilfe. Ihr seid echt klasse
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
WBCCon Mitglied Konstrukteur
Beiträge: 9 Registriert: 04.08.2021
|
erstellt am: 05. Aug. 2021 10:40 <-- editieren / zitieren --> Unities abgeben:
Haloo, ich habe jetzt aus meinen alten macros die beiden zusammengschnitten und das Macro funktioniert wunderbar. Danke für all die Hilfe. Hier nochmal das abgeänderte Macro von mir. Auch wen ich nicht so recht verstehe was ich gemacht habe. Option Explicit Dim swApp As SldWorks.SldWorks Dim swModelDoc As SldWorks.ModelDoc2 Dim swDrawingDoc As SldWorks.DrawingDoc Dim swSheet As SldWorks.Sheet Dim swExportPDFData As SldWorks.ExportPdfData Dim swView As SldWorks.View Dim nErrors As Long Dim nWarnings As Long Dim bRet As Boolean Sub main() On Error GoTo main_Error Set swApp = Application.SldWorks Set swModelDoc = swApp.ActiveDoc 'Wenn es keine Zeichnung ist, dann Fehler und raus If swModelDoc.GetType <> swDocDRAWING Then swApp.SendMsgToUser ("Nur für Zeichnungen!") Exit Sub End If 'DrawingDoc aus ModelDoc holen Set swDrawingDoc = swModelDoc 'Das aktuelle Blatt aus dem DrawingDoc holen Set swSheet = swDrawingDoc.GetCurrentSheet 'Speicherpfad festlegen Dim SavePath As String SavePath = Left(swModelDoc.GetPathName, InStrRev(swModelDoc.GetPathName, "\") - 1) 'aktueller Projektordner SavePath = SavePath & "\EXPORT\" 'Erweitert um den Export-Ordner 'Falls es den Ordner nicht gibt wird einer Erzeugt If Dir(Left(SavePath, Len(SavePath) - 1), vbDirectory) = "" Then MkDir (Left(SavePath, Len(SavePath) - 1)) End If '-------------------------------------------------------------------------------------------------------------------------------------------------------- ' _____/\\\\\\\\\\___/\\\\\\\\\\\\____ ' ___/\\\///////\\\_\/\\\////////\\\__ ' __\///______/\\\__\/\\\______\//\\\_ ' _________/\\\//___\/\\\_______\/\\\_ ' ________\////\\\__\/\\\_______\/\\\_ ' ___________\//\\\_\/\\\_______\/\\\_ ' __/\\\______/\\\__\/\\\_______/\\\__ ' _\///\\\\\\\\\/___\/\\\\\\\\\\\\/___ ' ___\/////////_____\////////////_____ 'Erste Ansicht holen (Die erste Ansicht ist das Blatt selbst) Set swView = swDrawingDoc.GetFirstView '...also die nächste nehmen Set swView = swView.GetNextView 'Jetzt das Modell aus des aktuellen Ansicht holen Dim MyReferencedModel As ModelDoc2 Set MyReferencedModel = swView.ReferencedDocument 'Den Dateinamen des aktuellen Modells nehmen und die Endung abschneiden Dim StepFileName As String StepFileName = Left(MyReferencedModel.GetTitle, Len(MyReferencedModel.GetTitle) - 0) '####### Einstellungen STEP ####### swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swStepExportPreference, swAcisOutputGeometryPreference_e.swAcisOutputAsSolidAndSurface 'Ausgabe als - Volumen-/Flächengeometrie swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swStepExportConfigurationData, False 'Gibt an, ob STEP-Konfigurationsdaten exportiert werden sollen swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swStepExportFaceEdgeProps, False 'Legt fest, ob Flächen- und Kanteneigenschaften exportiert werden sollen swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swStepExportSplitPeriodic, False 'Gibt an, ob periodische Flächen beim Export geteilt werden sollen swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swStepExport3DCurveFeatures, False 'Gibt an, ob 3D-Kurvenfeatures in die exportierte Datei aufgenommen werden sollen. 'Step Version swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swStepAP, 214 '(203 = STEP AP203 format / 214 = STEP AP214 format) '################################# 'Speichern mit aktuellen Dateinamen bRet = MyReferencedModel.Extension.SaveAs(SavePath & StepFileName & ".step", swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, nErrors, nWarnings) Debug.Print "STEP gespeichert?:" & bRet '-------------------------------------------------------------------------------------------------------------------------------------------------------- Dim swModel As DrawingDoc Dim swModExtension As ModelDocExtension Dim swExportData As ExportPdfData Dim sheetNames As Variant Dim sheetName As Variant Dim lWarnings As Long Dim lErrors As Long Dim Dateiname As String Dim Dateipfad As String Dim Endung As String Dim SW_DXF_Name As String Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc Set swModExtension = swModel.Extension Set swExportData = swApp.GetExportFileData(swExportDataFileType_e.swExportPDFData) swExportData.SetSheets swExportDataSheetsToExport_e.swExportData_ExportCurrentSheet, Nothing ' Loop all sheets and export sheetNames = swModel.GetSheetNames(0) Dim name As String Dateipfad = swModel.GetPathName() Dateiname = swModel.GetTitle If (swModel.GetType = swDocPART) Then Endung = ".SLDPRT" If (swModel.GetType = swDocASSEMBLY) Then Endung = ".SLDASM" If (swModel.GetType = swDocDRAWING) Then Endung = ".SLDDRW" If Len(Dateipfad) = 0 Then Exit Sub If Len(Dateiname) > 7 Then Dateiname = Left(Dateiname, Len(Dateiname) - 7) 'Speicherpfad festlegen SavePath = Left(swModelDoc.GetPathName, InStrRev(swModelDoc.GetPathName, "\") - 1) 'aktueller Projektordner SavePath = SavePath & "\EXPORT\" 'Erweitert um den Export-Ordner name = SavePath & Dateiname & ".pdf" swModel.ActivateSheet (sheetNames) swModExtension.SaveAs name, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Copy, swExportData, lErrors, lWarnings ' MsgBox " PDF wurde exportiert! " SavePath = Left(swModelDoc.GetPathName, InStrRev(swModelDoc.GetPathName, "\") - 1) 'aktueller Projektordner SavePath = SavePath & "\EXPORT\" 'Erweitert um den Export-Ordner name = SavePath & Dateiname & ".dxf" swModel.ActivateSheet (sheetNames) swModExtension.SaveAs name, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Copy, swExportData, lErrors, lWarnings ' MsgBox " PDF wurde exportiert! " SavePath = Left(swModelDoc.GetPathName, InStrRev(swModelDoc.GetPathName, "\") - 1) 'aktueller Projektordner SavePath = SavePath & "\EXPORT\" 'Erweitert um den Export-Ordner sheetNames = swModel.GetSheetNames(1) name = SavePath & Dateiname & "Abwicklung.dxf" swModel.ActivateSheet (sheetNames) swModExtension.SaveAs name, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Copy, swExportData, lErrors, lWarnings ' MsgBox " DXF wurde exportiert! " sheetNames = swModel.GetSheetNames(0) swModel.ActivateSheet (sheetNames) swApp.CloseDoc Dateipfad
End If On Error GoTo 0 Exit Sub main_Error: End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
WBCCon Mitglied Konstrukteur
Beiträge: 9 Registriert: 04.08.2021
|
erstellt am: 05. Aug. 2021 11:03 <-- editieren / zitieren --> Unities abgeben:
|
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|