---

2021-08-0411_27_56-Dateiinformation.png

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

---

Eine Zweite möglichkeit wäre:
wenn ich die Zeichnung öffne und das Macro Starte, dass das macro mir das dazugehörige Teil öffnet

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Original erstellt von WBCCon:
Eine Zweite möglichkeit wäre:
wenn ich die Zeichnung öffne und das Macro Starte, dass das macro mir das dazugehörige Teil öffnet

---

Hallo und herzlich Willkommen hier im Forum.

Zu diesem Thema kannst du ja mal mein Makro anschauen und evtl. etwas anpassen.

https://ww3.cad.de/foren/ubb/Forum2/HTML/026683.shtml#000000

Grüße, Andi

------------------
Hast du kein Problem?
Such dir eins. ( Und löse es )

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

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

---

210804_Zeichnung_aus_Teil_erstellen.JPG

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

---

Es gibt die Funktion zugehörige Zeichnung öffnen aus dem Modell heraus, RMT im Feature-Baum auf das Modell und dann links oben. Wäre das nicht einfacher?

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

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

---

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

---

Das Teils aus der Zeichnung zu öffnen ist auf jeden Fall der sinnvollere Weg.

Beinhaltet denn eine Zeichnungsdatei bei euch nur ein Teil? Oder soll es immer das Teil des aktuellen Blattes öffnen.
Was auch geht ist eine Schleife über eine Stückliste und dann darüber zu öffnen.

Für mich wäre wichtig wonach soll entschieden werden welches Teil er aus der Zeichnung nimmt.

Gruß 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

---

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

---

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

---

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

---

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.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

    '--------------------------------------------------------------------------------------------------------------------------------------------------------
    '____/\\\\\\\\\______/\\\\\\\\\\\\____
    ' __/\\\///////\\\___\/\\\////////\\\__
    '  _\///______\//\\\__\/\\\______\//\\\_
    '  ___________/\\\/___\/\\\_______\/\\\_
    '    ________/\\\//_____\/\\\_______\/\\\_
    '    _____/\\\//________\/\\\_______\/\\\_
    '      ___/\\\/___________\/\\\_______/\\\__
    '      __/\\\\\\\\\\\\\\\_\/\\\\\\\\\\\\/___
    '        _\///////////////__\////////////_____

    '####### 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

---

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

---

Hi Willi,

ich das Teil aus deiner Ansicht schon gespeichert?
Wenn es ein neues Teil ist was noch mit als SLDPRT im Ordner liegt, kann er keinen  Namen von .gettitle bekommen.

Gruß 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

---

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

---

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

---

EXPORT_STEP_DXF_DXF_PDF_2021.zip

Ein Dank besonders an dich Kevin.
Das erspart mir einiges an Zeit.

Im Anhang nochmal das Macro

LG
Willi

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP