---

Guten Morgen  ,

Könnte mir jmd. ein Makro bereitstellen mit dem ich aus der aktiven Zeichnung das  zugehörige Teil oder Baugruppe öffnen kann?
Benötige dies für ein Makro mit dem ich PDF,DXF und STEP aus Zeichnung und Part erstelle und an einem Ort abspeichere.
Danke im Voraus. 

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

---

Code:

---

    'Modell holen
    Set View = swModel.GetFirstView
    Set View = View.GetNextView
   
    ViewName = View.Name
    RefModelName = View.GetReferencedModelName
   
    Select Case UCase(Right(RefModelName, 6))
    Case "SLDPRT"
        SWXTypeOfFile = swDocPART
    Case "SLDASM"
        SWXTypeOfFile = swDocASSEMBLY
    Case "SLDDRW"
        SWXTypeOfFile = swDocDRAWING
    Case Else
        SWXTypeOfFile = swDocNONE
    End Select
   
    If SWXTypeOfFile = swDocNONE Then
        MsgBox "Leere Zeichnung!", vbCritical, "Fehler!"
        End
    End If
   
    ConfigName = View.ReferencedConfiguration
   
    Set swPart = swApp.OpenDoc(RefModelName, SWXTypeOfFile)
    Set swPart = swApp.ActivateDoc2(RefModelName, True, nErrors) 'swPart wird manchmal nicht korrekt zugewiesen, deshalb "doppelte" Zuweisung

---

Gruß, Jens

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

---

Danke Jens für die schnelle Antwort.

Kannst du mir das unten einpflegen? Wo ich das geöffnete Part oder die Baugruppe als STEP abspeichere. Steh da auf dem Schlauch 

Sub main()

Dim swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, sPathName As String
Dim sReference As String, sSaveName As String, longstatus As Long, myRev As String

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

If swModel Is Nothing Then
    MsgBox ("Pas de document ouvert")
ElseIf swModel.GetType <> 3 Then
    MsgBox ("Il ne s'ag?t pas d'une mise en plan")
Else
  sPathName = swModel.GetPathName 'recupere le nom complet du document actif
  sReference = Mid(sPathName, InStrRev(sPathName, "\") + 1) 'R?cup?re tout ce qui se situe apr?s le dernier \
  sReference = Left(sReference, Len(sReference) - 7) 'Suppression des 6 caract?res correspondant ? l'extension de fichier et du .
Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc

' Zoom To Fit
Part.ViewZoomtofit2
Part.SheetPrevious

' Redraw
Part.GraphicsRedraw2

' Zoom to Area
Part.ViewZoomTo2 0, 0, 0, 0.1, 0.1, 0.1

' Zoom to Area
Part.ViewZoomTo2 0, 0, 0, 0.1, 0.1, 0.1

' Zoom to Area
Part.ViewZoomTo2 0, 0, 0, 0.1, 0.1, 0.1

' Zoom to Area
Part.ViewZoomTo2 0, 0, 0, 0.1, 0.1, 0.1

' Zoom to Area
Part.ViewZoomTo2 0, 0, 0, 0.1, 0.1, 0.1

' Save As
longstatus = Part.SaveAs3("V:\CAD-Dateien\" + sReference + ".DXF", 0, 0)

' Zoom To Fit
Part.ViewZoomtofit2

' Save As
longstatus = Part.SaveAs3("V:\CAD-Dateien\" + sReference + ".PDF", 0, 0)

' Zoom To Fit
Part.ViewZoomtofit2

' Save As
'longstatus = Part.SaveAs3("Z:\Auftr?ge\2018\AT-18-3910 VACUUMSCHMELZE -- Aut. Drahtabisolier und Wickelanlage\06-Konstruktion\09-Doku\12 - Zeichnungen\TIF\" + sReference + ".TIF", 0, 0)
'boolstatus = Part.ActivateView("Zeichenansicht4")
'boolstatus = Part.Extension.SelectByID2("Zeichenansicht4", "DRAWINGVIEW", 5.69026915807265E-02, 0.182964526197014, 0, False, 0, Nothing, 0)
'Part.OpenCompFile

' Open (Hier sollte das Part zur aktuellen Ansicht geöffnet werden)
Set Part = swApp.OpenDoc6("C:\DPSMZVS\Projekte\Kunden\Vacuumschmelze\AT-18-3910 Automarische Drahabisolier und Wickelanlage\" + sReference + ".SLDPRT", 1, 192, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 22
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "" + sReference + ".SLDPRT", False, longstatus
Set Part = swApp.ActiveDoc
Part.ClearSelection2 True
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized

' Save As
longstatus = Part.SaveAs3("V:\CAD-Dateien\" + sReference + ".STEP", 0, 0)

' Close Document
'swPart = Nothing
Set Part = Nothing
swApp.CloseDoc "" + sReference + ".SLDPRT"
Set Part = swApp.ActiveDoc
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "" + sReference + " - Blatt1", False, longstatus
Set Part = swApp.ActiveDoc
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized

End If

End Sub

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

---

Ohne Test:

Code:

---

' Open (Hier sollte das Part zur aktuellen Ansicht geöffnet werden)
Set View = Part.GetFirstView
    Set View = View.GetNextView
 
    RefModelName = View.GetReferencedModelName
 
    Select Case UCase(Right(RefModelName, 6))
    Case "SLDPRT"
        SWXTypeOfFile = swDocPART
    Case "SLDASM"
        SWXTypeOfFile = swDocASSEMBLY
    Case "SLDDRW"
        SWXTypeOfFile = swDocDRAWING
    Case Else
        SWXTypeOfFile = swDocNONE
    End Select
 
    Set Part = swApp.OpenDoc(RefModelName, SWXTypeOfFile)
    Set Part = swApp.ActivateDoc2(RefModelName, True, nErrors)

'Set Part = swApp.OpenDoc6("C:\DPSMZVS\Projekte\Kunden\Vacuumschmelze\AT-18-3910 Automarische Drahabisolier und Wickelanlage\" + sReference + ".SLDPRT", 1, 192, "", longstatus, longwarnings)
'Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 22
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "" + sReference + ".SLDPRT", False, longstatus
Set Part = swApp.ActiveDoc
Part.ClearSelection2 True
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized

' Save As
longstatus = Part.SaveAs3("V:\CAD-Dateien\" + sReference + ".STEP", 0, 0)

---

Gruß, Jens

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

---

Zitat:

---

Original erstellt von Sebocali:
Guten Morgen    ,

Könnte mir jmd. ein Makro bereitstellen mit dem ich aus der aktiven Zeichnung das  zugehörige Teil oder Baugruppe öffnen kann?
Benötige dies für ein Makro mit dem ich PDF,DXF und STEP aus Zeichnung und Part erstelle und an einem Ort abspeichere.
Danke im Voraus.   

---

Bin auch grad dabei sowas zu programmieren.

Mein Makro muss alle Dateien in den eingegebenen Verzeichnis  (Wahlweise mit oder ohne Unterverzeichnisse) durchsuchen, alle Zeichnungen öffnen und schauen ob in dem Part bei Eigenschaften => Lieferanten ein bestimmter Name steht und dann die Zeichnung als pdf, dwg oder den Part zusätzlich als Step in ein Zielverzeichnis abspeichern.

So möchte ich mir nach Projektfertigstellung die mühsame abspeicherei für unsere Zulieferer ersparen.
Bei mir kanns aber noch länger dauern, ich scheitere leider immer wieder an den einfachsten Programmier-Geschichten.  

Wenn du was hast, sag Bescheid, und wenn ich meins habe, dann geb ich Bescheid.

[Diese Nachricht wurde von - HH - am 01. Nov. 2020 editiert.]

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