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