---

Teil12.JPG

Hallo alle miteinander 

und zwar bin ich leider nirgends fündig geworden, was dieses Thema anbelangt. Und zwar würde ich gerne aus einem Solidworks "Part" (irgendein Part) eine DXF-Datei aus mehreren Ansichten erstellen, indem das Makro folgende Aufgaben übernehmen soll: Neue Zeichnung vom bereits erstellten Part öffnen, 6 Ansichten des Modells auf DIN A4 erstellen im Maßstab 1:1 (Vorne, Hinten, Seite links, Seite rechts, Oben, Unten), Speichern unter, und dann als DXF-Format im Ordner des Modells speichern, danach soll die Zeichnung sich wieder schließen, sodass man auf das Part zurückkommt.
Ich habe leider keine so richtige Ahnung von Makros und hoffe, dass mir hier einer helfen kann! 
Ich habe schon einmal so ein bisschen rumprobiert, aber dabei ist nichts wirklich bei rumgekommen, trotzdem als Info schonmal vorab.
Und schonmal vielen Dank für die Hilfe 
Ich habe ein Bild angehängt, wie die normale Aufteilung bei uns ist.

Sub main()
 
    Dim swApp As SldWorks.SldWorks          'Zugriff auf SolidWorks
    Dim swModel As SldWorks.ModelDoc2      'Zugriff auf Aktuelles Dokument
    Dim swSelMgr As SldWorks.SelectionMgr  'Zugriff auf Auswahl des Benutzers
    Dim instance As IDrawingDoc
    Dim value As Boolean
   

'SolidWorks-Objekt erstellen und mit Aktivem Dokument verbinden
Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Set swSelMgr = swModel.SelectionManager

 
'Zeichnung wird geöffnet
Set Drawing = swApp.NewDocument("X:\Technik\SOLIDWORKS_Vorlagen\Dokumentvorlagen\Zeichnung.drwdot", 12, swSheetWidth, swSheetHeight)
value = instance.GenerateViewPaletteViews("swModel")

'boolstatus = Part.GenerateViewPaletteViews

'Ändere Blattformat auf DXF_neu
'boolstatus = Part.SetupSheet5("Blatt1", 12, 12, 1, 1, True, "DXF_neu.slddrt", 0.42, 0.297, "Standard", True)

'Set swView = swDraw.CreateDrawViewFromModelView3(CompPathNames(i), "*Vorderseite", LocX, LocY, 0)

'    sModelPfad = PartDoc.GetPathName
'    If (PartDoc.ExportToDWG(sPfad & "\" & sBenenn2 & ".DXF", sModelPfad, 2, True, Null, False, False, 0, Null) <> True) Then
'        Call MsgBox("Beim Speichern von " & Chr(34) & sBenenn2 & ".DXF" & Chr(34) & " ist ein Fehler aufgetreten!", vbOKOnly, "Fehler !")
'    End If

'    'Dokument schließen
'    sVerz = PartDoc.GetTitle
'    Set PartDoc = Nothing
'    SwApp.CloseDoc sVerz
 
End Sub

Ist nicht viel aber besser als nichts 

Gruß
Kevin

------------------
Gruß
Kevin

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

---

Vorschlag:
Erstellen eine Vorlage mit Vordefinierten Ansichten
Hier findest du ein Beispiel-Makro wie man diese Vorlage mit dem Modell befüllt.
Und zuletzt ein Beispiel wie man als DXF speichert. Save Drawing as DXF Example (VBA)

------------------
21 ist nur die halbe Antwort.

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

---

Hallo Henry,

vielen Dank für deine schnelle Antwort.
Das hat mich schon um einiges weitergebracht. Allerdings habe ich das Problem, dass Solidworks eine Fehlermeldung bei der Erstellung der dxf rausgibt. Ich vermute, ich hätte den sPathName bei "Endung des Modells entfernen" noch einmal anders benennen müssen? Allerdings hat das auch nicht richtig funktioniert Kann mir da einer bei meinem Problem helfen?    Es soll der Pfad des Modells genommen werden, wo die dxf abgespeichert werden soll.

Code:

Dim swApp As SldWorks.SldWorks
Dim swModel  As SldWorks.ModelDoc2
Dim oDrawingDoc As SldWorks.DrawingDoc
Dim bRetVal As Boolean
Dim sPathName As String
Dim nErrors As Long
Dim nWarnings As Long
Dim nRetval As Long
Dim bShowMap As Boolean
Dim bRet As Boolean

' Vorlagenpfad bitte hier anpassen
Const sVorlagenPfad = "X:\Technik\SOLIDWORKS_Vorlagen\Erstellung DXF aus Teil\Zeichnung_DXF.DRWDOT"

Sub main()

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

    ' Dateiname von aktiven Modell holen
    sPathName = swModel.GetPathName

    If sPathName = "" Then
        MsgBox ("Aktives Dokument ist nicht gespeichert!")
        Exit Sub
    End If

    ' Prüfen ob Dateiendung an Pfad hängt, wenn nicht anhängen.
    If InStr(sPathName, ".") = 0 Then
        If swModel.GetType = swDocASSEMBLY Then
            sPathName = sPathName & ".sldasm"
        ElseIf swModel.GetType = swDocPART Then
            sPathName = sPathName & ".sldprt"
        Else
            MsgBox ("Aktives Modell kann nicht eingefügt werden!")
            Exit Sub
        End If
    End If
 
    ' Zeichnungsvorlage öffnen
    Set oDrawingDoc = swApp.NewDocument(sVorlagenPfad, 2, 0.2794, 0.4318)
    bRetVal = oDrawingDoc.InsertModelInPredefinedView(sPathName)

    If bRetVal = False Then
        MsgBox ("Es ist ein Fehler aufgetreten! Einfügen des Modells in die vordefinierte Zeichnungsansicht fehlgeschlagen.")
        Exit Sub
    End If

  ' Endung des Modells entfernen (.sldprt)
    ' und dxf Endung anhängen (.dxf)
    sPathName = swModel.GetPathName
    sPathName = Left(sPathName, Len(sPathName) - 6)
    sPathName = sPathName + "dxf"

    ' Zeige momentane Einstellungen
    Debug.Print "DxfMapping            = " & swApp.GetUserPreferenceToggle(swDxfMapping)
    Debug.Print "DXFDontShowMap        = " & swApp.GetUserPreferenceToggle(swDXFDontShowMap)
    Debug.Print "DxfVersion            = " & swApp.GetUserPreferenceIntegerValue(swDxfVersion)
    Debug.Print "DxfOutputFonts        = " & swApp.GetUserPreferenceIntegerValue(swDxfOutputFonts)
    Debug.Print "DxfMappingFileIndex    = " & swApp.GetUserPreferenceIntegerValue(swDxfMappingFileIndex)
    Debug.Print "DxfOutputLineStyles    = " & swApp.GetUserPreferenceIntegerValue(swDxfOutputLineStyles)
    Debug.Print "DxfOutputNoScale      = " & swApp.GetUserPreferenceIntegerValue(swDxfOutputNoScale)
    Debug.Print "DxfMappingFiles        = " & swApp.GetUserPreferenceStringListValue(swDxfMappingFiles)
    Debug.Print "DxfOutputScaleFactor  = " & swApp.GetUserPreferenceDoubleValue(swDxfOutputScaleFactor)
    Debug.Print ""

    ' Turn off showing of map
    bShowMap = swApp.GetUserPreferenceToggle(swDXFDontShowMap)
    Debug.Print "bShowMap = " & bShowMap

    swApp.SetUserPreferenceToggle swDXFDontShowMap, False

    bRet = swModel.SaveAs4(sPathName, swSaveAsCurrentVersion, swSaveAsOptions_Silent, nErrors, nWarnings)

    If bRet = False Then
        nRetval = swApp.SendMsgToUser2("Problems saving file.", swMbWarning, swMbOk)
    End If

    ' Restore showing of map
    swApp.SetUserPreferenceToggle swDXFDontShowMap, bShowMap

End Sub

------------------
Gruß
Kevin

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

---

Die dxf wird nicht abgespeichert, da dein swModel (activedoc) noch beim PART oder ASSEMBLY ist.
Versuch mal vor der Zeile zum abspeichern der dxf:

set swModel = swapp.activedoc

Dadurch ändert sich dein aktives Dokument auf die Zeichnung und die dxf kann erstellt werden.

Grüße

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

---

Mal ein ganz anderer Ansatz zur Überlegung:

Man kann auch direkt aus dem Part heraus eine DXF erstellen. Damit spart man sich das ganze Zeichnungs-Gefummel.

Anbei mal eine Funktion, die ich genau dafür geschrieben habe. Da ich die für die Veröffentlichung hier leicht angepasst habe, kann es sein, dass ein Paar kleinere Bugs drin sind. 

Die Funktion speichert von Blechteilen eine dxf der Abwicklung, bei normalen Teilen eine dxf einer Ansicht senkrecht zur größten Fläche (wir machen hauptsächlich Platten, da ist das meistens dass, was wir zum Lasern brauchen). Im Prinzip muss man nur statt des "*Normal auf" mit einer Schleife die gewünschten Standard-Ansichten durchgehen und speichern. Ergibt halt dann pro Ansicht eine dxf.

Code:

---

Function Convert2DXF(Ablage, FileName, Filepath, Optional ByVal BGName As String = "") as Boolean

Dim varAlignment As Variant
Dim dataAlignment(11) As Double
Dim varViews As Variant
Dim dataViews(0) As String
Dim vBoundBox As Variant
Dim instance As IModelView
Dim value As MathTransform
Dim vBodies
Dim swFeat As SldWorks.Feature
   
    bool1 = False
    bool2 = False
    Ist_Blechteil = False

Set swDoc2 = swApp.ActiveDoc
    Set PartExt = swDoc2.Extension
   
'Ist Blechteil?
    Set swFeat = swDoc2.FirstFeature
    Do While Not swFeat Is Nothing
        'Blechteil markieren
        If swFeat.Name Like "*Abwicklung*" Then Ist_Blechteil = True
        Set swFeat = swFeat.GetNextFeature
    Loop

'einzelne Körper von Mehrkörperteilen isolieren
    vBodies = swDoc2.GetBodies2(swSolidBody, True)
   
    For i = 0 To UBound(vBodies)

        Set vBody = vBodies(i)
           
            'Dateiname generieren
            If UBound(vBodies) = 0 Then
                saveFileName = Ablage & BGName & Replace(LCase(FileName), "sldprt", "dxf")
            Else
                'lfd. Nr. vergeben
                Select Case i
                    Case 0 To 9
                        lfdNr = "__0" & i
                    Case Else
                        lfdNr = "__" & i
                End Select
               
                saveFileName = Ablage & BGName & Replace(LCase(FileName), ".sldprt", lfdNr & ".dxf")
            End If
           
            swDoc2.ClearSelection2 True

            vBodyID = vBody.GetSelectionId
           
            bool = PartExt.SelectByID2(vBodyID, "SOLIDBODY", 0#, 0#, 0#, False, 0, Nothing, swSelectOptionDefault)
           
            'isolieren
            swApp.RunCommand swCommands_Comp_Isolate, ""
            'DoEvents

            'Orientierung des Models auslesen
           
            dataAlignment(0) = 0#
            dataAlignment(1) = 0#
            dataAlignment(2) = 0#
            dataAlignment(3) = 1#
            dataAlignment(4) = 0#
            dataAlignment(5) = 0#
            dataAlignment(6) = 0#
            dataAlignment(7) = 1#
            dataAlignment(8) = 0#
            dataAlignment(9) = 0#
            dataAlignment(10) = 0#
            dataAlignment(11) = 1#
           
            varAlignment = dataAlignment
           
            'größte Fläche auswählen
            swDoc2.ClearSelection2 True
           
            Set vFace = vBody.GetFirstFace
         
            maxFläche = 0
               
            Set swSelMgr = swDoc2.SelectionManager
            Set swSelData = swSelMgr.CreateSelectData
           
            ViewName = "TempView"

           
            Do While Not vFace Is Nothing
                aktiveFläche = vFace.GetArea
               
                If aktiveFläche > maxFläche Then
                    maxFläche = aktiveFläche
                    Set vEntity = vFace
           
                    'auswählen
                    bool = vEntity.Select4(False, swSelData): Debug.Assert bool
                End If
               
                Set vFace = vFace.GetNextFace
            Loop
           
            'Ansicht normal auf Fläche
            swDoc2.ShowNamedView2 "*Normal auf", -1
           
            'temp. Ansicht erzeugen
            swDoc2.NameView ViewName
           
            dataViews(0) = ViewName
            varViews = dataViews
           
            If Not Ist_Blechteil Then
                'als normale dxf
                bool1 = swDoc2.ExportToDWG2(saveFileName, Filepath, swExportToDWG_ExportAnnotationViews, True, varAlignment, False, False, 0, varViews)
            Else
                'Blech-dxf
                'options = 193
                options = 49 ' flat-pattern geometry, merge coplanar faces, library features
                bool2 = swDoc2.ExportToDWG2(saveFileName, Filepath, swExportToDWG_ExportSheetMetal, True, varAlignment, False, False, options, Null)
            End If
           
            If bool1 Or bool2 Then Convert2DXF = True Else Convert2DXF = False
           
            'exit isolation
            swApp.RunCommand swCommands_Comp_Isolate_Exit, ""
            'DoEvents
           
            If bool2 Then vBodies = swDoc2.GetBodies2(swSolidBody, True)
           
            swDoc2.DeleteNamedView ViewName
        Next i
     
End Function

---

Gruß, Jens

------------------
CSWA, CSWP, CSWPA-SM & -SU & -DT =)

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

---

Hallo zusammen,

ok mein Code funktioniert soweit so gut. Ich habe mir noch ein paar andere Infos zusammengesucht, damit gings gut.
Jetzt kann ich eine dxf erzeugen und es schließt die Zeichnung hinterher auch wieder. Das einzige, was mir ein bisschen missfällt, ist, dass die vordefinierte Zeichenansicht sich nicht an das Teil automatisch anpasst. Wenn man also ein kleines Teil hat sieht es soweit ganz gut aus. Allerdings wenn das Teil 2 Meter ist, dann sieht es so aus, als ob die Ansichten in einem Teil zusammenhängen. Kann man das auch irgendwie programmieren, dass sich die vordefinierte Zeichnungsvorlage an das Modell anpasst? Und wenn ja wie? 

@Jens: Wo muss ich diese Funktion einbauen? 
Habe leider überhaupt keinen Plan, wie das mit der Funktion läuft 
Allerdings brauche ich das alles wenn dann auch nur in einer dxf Datei, sonst wird es für unsere Fräser zu kompliziert (und ich will denen nicht mehr Arbeit verschaffen, jedes Mal eine neue Dxf öffnen zu lassen  ). Wir steigen eventuell bald auf SolidCam um, allerdings kann sich das noch ca. 2 Jahre hinziehen... 

Ich hoffe es hat noch jemand einen Vorschlag dazu? 

Hier ist mein bisheriger Code, der läuft bisher gut:

Dim swApp As SldWorks.SldWorks
Dim swModel  As SldWorks.ModelDoc2
Dim oDrawingDoc As SldWorks.DrawingDoc
Dim bRetVal As Boolean
Dim sPathName As String
Dim sPartName As String
Dim nErrors As Long
Dim nWarnings As Long
Dim nRetval As Long
Dim bShowMap As Boolean
Dim bRet As Boolean
Dim SaveAs3 As Long
Dim Name As String

' Vorlagenpfad bitte hier anpassen
Const sVorlagenPfad = "X:\Technik\SOLIDWORKS_Vorlagen\Erstellung DXF aus Teil\Zeichnung_DXF.DRWDOT"

Sub main()

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

    ' Dateiname von aktiven Modell holen
    sPathName = swModel.GetPathName

    If sPathName = "" Then
        MsgBox ("Aktives Dokument ist nicht gespeichert!")
        Exit Sub
    End If

    ' Prüfen ob Dateiendung an Pfad hängt, wenn nicht anhängen.
    If InStr(sPathName, ".") = 0 Then
        If swModel.GetType = swDocASSEMBLY Then
            sPathName = sPathName & ".sldasm"
        ElseIf swModel.GetType = swDocPART Then
            sPathName = sPathName & ".sldprt"
        Else
            MsgBox ("Aktives Modell kann nicht eingefügt werden!")
            Exit Sub
        End If
    End If
 
    ' Zeichnungsvorlage öffnen
    Set oDrawingDoc = swApp.NewDocument(sVorlagenPfad, 2, 0.2794, 0.4318)
    bRetVal = oDrawingDoc.InsertModelInPredefinedView(sPathName)

    If bRetVal = False Then
        MsgBox ("Es ist ein Fehler aufgetreten! Einfügen des Modells in die vordefinierte Zeichnungsansicht fehlgeschlagen.")
        Exit Sub
    End If

  ' Endung des Modells entfernen (.sldprt)
    ' und dxf Endung anhängen (.dxf)
    sPartName = swModel.GetPathName
    sPartName = Left(sPathName, Len(sPathName) - 6)
    sPartName = sPartName + "dxf"

    ' Zeige momentane Einstellungen
    Debug.Print "DxfMapping            = " & swApp.GetUserPreferenceToggle(swDxfMapping)
    Debug.Print "DXFDontShowMap        = " & swApp.GetUserPreferenceToggle(swDXFDontShowMap)
    Debug.Print "DxfVersion            = " & swApp.GetUserPreferenceIntegerValue(swDxfVersion)
    Debug.Print "DxfOutputFonts        = " & swApp.GetUserPreferenceIntegerValue(swDxfOutputFonts)
    Debug.Print "DxfMappingFileIndex    = " & swApp.GetUserPreferenceIntegerValue(swDxfMappingFileIndex)
    Debug.Print "DxfOutputLineStyles    = " & swApp.GetUserPreferenceIntegerValue(swDxfOutputLineStyles)
    Debug.Print "DxfOutputNoScale      = " & swApp.GetUserPreferenceIntegerValue(swDxfOutputNoScale)
    Debug.Print "DxfMappingFiles        = " & swApp.GetUserPreferenceStringListValue(swDxfMappingFiles)
    Debug.Print "DxfOutputScaleFactor  = " & swApp.GetUserPreferenceDoubleValue(swDxfOutputScaleFactor)
    Debug.Print ""

    ' Turn off showing of map
    bShowMap = swApp.GetUserPreferenceToggle(swDXFDontShowMap)
    Debug.Print "bShowMap = " & bShowMap

    swApp.SetUserPreferenceToggle swDXFDontShowMap, False

    bRet = oDrawingDoc.SaveAs3(sPartName, 0, 0)

'Zeichnung wieder schließen
Name = oDrawingDoc.GetPathName()
swApp.CloseDoc Name

End Sub

------------------
Gruß
Kevin

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