---

Hallo,
wir speichern bei uns hier im Betrieb Blechteile, die gelasert werden, auf Blatt 2 einer Zeichnung ab und exportieren dann diese Geometrie als dxf-file in einen Ordner, auf dem dann der Maschinist Zugang hat. Die Teile haben bei uns eine Teilenummer und eine Zeichnungsnummer, die aus pro.file generiert wird (und auch auf der Zeichnung draufsteht).
Da das exportieren händisch passiert, und somit auch mal vergessen wird, könnte ich mir ein Makro vorstellen, das dies übernimmt.
Probleme könnten die Änderungsstufen hervorrufen. Bei einem jungfräulichen Teil lautet dann die Nummer z.B  123456_0.dxf, wobei die Zifferfolge 123456 die Zeichnungsnummer ist und die 0 der Änderungsstand. Bei der ersten Änderung würde sie dann 123456_a.dxf heißen.
Hat jemand eine Idee, wie man dies mit einem Makro erschlagen könnte?
Gruß

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

---

Hallo Jomage,

Klar kann man das mit einem Makro erschalgen. Aber ihr setzt doch ein ausgewachsenes PDM-System
ein. Habt ihr auch einen Imageserver für SolidWorks dem PDM angehängt (Erzeugung von
Neutralformaten wie z.B. TIFF oder PDF). Wenn ja, dann könnt ihr das Erzeugen von einem DXF
in den Workflow der Freigabe integrieren, ev. gesteuert über eine Klassierung (damit nicht
alle Zeichnungen exportiert werden). Somit muss sich der User nicht mehr darum kümmern, und
der Prozess läuft im Hintergrund ab.

Ansonsten hier das Makro welches wir verwenden, um ein DXF zu erstellen (da leider noch
kein ausgewachsenes PDM - System vorhanden ist).

Code:

---

Sub dxf_export_makro()

Dim swApp As Object
Dim Part As Object
Dim sPathName As String
Dim nRetVal As Long
Dim nErrors As Long
Dim nWarnings As Long
Dim bRet As Boolean
Dim retval As Boolean
Dim vSheetProps As Variant
Dim blattsize As Long
Dim SelObj As Object

Set swApp = CreateObject("SldWorks.Application")
Set Part = swApp.ActiveDoc
Set DrawingDoc = swApp.ActiveDoc

'setzen der DXF-Einstellungen
retval = swApp.SetUserPreferenceIntegerValue(swDxfVersion, 2) ' Version, funktioniert
retval = swApp.SetUserPreferenceIntegerValue(swDxfOutputFonts, 0) 'Schriftart, funktioniert
'retval = swApp.SetUserPreferenceIntegerValue(swDxfMappingFileIndex, 0) 'wofür ?
linestyle = swApp.SetUserPreferenceIntegerValue(swDxfOutputLineStyles, 0) 'Linienarten, funktioniert
retval = swApp.SetUserPreferenceIntegerValue(swDxfOutputNoScale, 1) 'Aktivieren Ausgabemassstab 1:1, funktioniert
'retval = swApp.SetUserPreferenceDoubleValue(swDxfOutputScaleFactor, 0) 'wofür ?
retval = swApp.SetUserPreferenceStringListValue(swDxfMappingFiles, "Pfad zur Abbildungsdatei angeben") 'Abbildungsdatei, funktioniert
retval = swApp.SetUserPreferenceToggle(swDXFDontShowMap, True) 'Abbildung nicht bei jedem Speichern anzeigen, funktioniert
retval = swApp.SetUserPreferenceToggle(swDxfMapping, True) ' Aktivieren Abbildungsdatei, funktioniert
retval = swApp.SetUserPreferenceIntegerValue(swDxfMultiSheetOption, 0) 'Zeichnung mit mehreren Blättern, funktioniert

' Ab hier wird der Dateiname erzeugt, Logik kann übernommen werden, muss aber entsprechend
  angepasst werden.

' Abfrage der Sach und Auftragsnummer
unique_number = Part.GetCustomInfoValue("", "EDMIDENTNR")
NewAuftrag = Part.GetCustomInfoValue("", "EDMAUFTRNR")

Const swDocDRAWING = 3

'Abfrage des Indexes (Über das Modell)
PartTitle = Part.GetTitle
Set SelMgr = Part.SelectionManager()
Part.SelectByID "", "DRAWINGVIEW", 0, 0, 0
Set SelObj = SelMgr.GetSelectedObject3(1)
SelObjType = SelMgr.GetSelectedObjectType2(1)

ModelName = SelObj.GetReferencedModelName
Set Part = swApp.ActivateDoc(ModelName)
PartIndex = Part.GetCustomInfoValue("", "EDMVERSION")
Set Part = Nothing
Set Part = swApp.ActivateDoc(PartTitle)

' Löschen der Variable
msgtxt = ""

' die Anzahl der Blätter holen, und dann in der Schleife eines nach
' dem anderen Abspeichern. Dazu ein Handle auf das aktuelle Blatt holen
AnzahlBl = DrawingDoc.GetSheetCount
Set Sheet = DrawingDoc.GetCurrentSheet

' wenn mehr als ein Blatt da ist könnte es sein, dass wir nicht auf
' Blatt 1 sind. In einem Makro müssen wir jetzt einen Trick machen, um
' auf das erste Blatt zurückzukommen.
' Dazu immer wieder ein Blatt zurückspringen und dabei den Blattnamen
' vergleichen; wenn der gleich bleibt haben wir das erste Blatt erreicht.

For i = 1 To AnzahlBl - 1
    SheetName = Sheet.GetName
    DrawingDoc.SheetPrevious
    Set Sheet = DrawingDoc.GetCurrentSheet
    If (SheetName = Sheet.GetName) Then
        Exit For
    End If
    Next i
' jetzt sind wir garantiert auf dem ersten Blatt und können jetzt eins
' nach dem anderen Abspeichern

For i = 1 To AnzahlBl

    'Zusammenstellen des Speichernnamens
    If NewAuftrag = "" Or NewAuftrag = " " Then
        sav_name = unique_number & "_" & PartIndex & "_" & i & ".DXF"
      Else
        sav_name = NewAuftrag & "_" & unique_number & "_" & PartIndex & "_" & i & ".DXF"
        End If
       
       
    'Ergänzung des Speicherpfades
    If auswahl.dxf_out.Value = True Then
        sPathName = "R:\3D_DATEN\SWX\DXF-DWG-Export\" & sav_name
      Else
        MakeSureDirectoryPathExists "D:\Working\export\"
        sPathName = "D:\working\export\" & sav_name
        End If

    ' dann erfolgt das Speichern, die Parameter sind:
    ' DrawingDoc.SaveAs2 ( newName, unused, saveAsCopy, silent )
    ' wenn alles geklappt hat, wird eine 0 zurückgeliefert, ansonsten ein
    ' Wert ungleich 0
    If (DrawingDoc.SaveAs2(sPathName, 0, True, False)) Then
        MsgBox "FEHLER BEIM SPEICHERN VON " & sPathName & Chr$(10) & Chr$(13)
        msgtxt = msgtxt & "*** FEHLER bei: " & sPathName & Chr$(10) & Chr$(13)
      Else
        msgtxt = msgtxt & "erfolgreich gespeichert: " & sPathName & Chr$(10) & Chr$(13)
        End If

    ' und wenn noch Blätter kommen dieses aktivieren
    If AnzahlBl > i Then
        DrawingDoc.SheetNext
        End If
    Next i

' und noch die Zusammenfassung übers Speichern ausgeben
MsgBox msgtxt

End Sub

---

Das Makro basiert darauf, dass eine Ansicht selektiert ist. Das dahinerliegende Modell
gibt mit seinen Eigenschaften dem DXF den Dateinamen .
Das Makro läuft bei uns auf der Version SWX 2006 SP5. Keine Ahnung ob es bei neueren oder älteren
Versionen auch läuft.

Gruss
Mike

------------------

The Power Of Dreams

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

---

Moin!
Wir machen das per Makro und lassen das dxf zippen, damit es für Email kompakt zur Verfügung steht. Zur Sicherheit gibt es ein PDF noch dazu.

Private Declare Function OpenProcess Lib "kernel32" _
      (ByVal dwDesiredAccess As Long, _
      ByVal bInheritHandle As Long, _
      ByVal dwProcessId As Long) As Long
     
Private Declare Function GetExitCodeProcess Lib "kernel32" _
      (ByVal hProcess As Long, lpExitCode As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" _
      (ByVal hObject As Long) As Long

Option Explicit
    Dim swApp                  As SldWorks.SldWorks
    Dim swModel                As SldWorks.ModelDoc2
    Dim sPathName              As String
    Dim sDXFName                As String
    Dim sPDFName                As String
    Dim sZIPName                As String
    Dim sFileName              As String
    Dim nErrors                As Long
    Dim nWarnings              As Long
    Dim nRetval                As Long
    Dim bShowMap                As Boolean
    Dim bRet                    As Boolean
    Dim ConfName                As String
    Dim index                  As String
    Dim fs
    Dim a
Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    ' Strip off SolidWorks drawing file extension (.slddrw)
    ' and add DXF file extension (.dxf)
    sPathName = swModel.GetPathName
    sPathName = Left(sPathName, Len(sPathName) - 7)
    sFileName = ohnePfad(sPathName)
    'sDXFName = ohnePfad(sPathName) + "dxf"
    'sPDFName = ohnePfad(sPathName) + "pdf"
    'sZIPName = ohnePfad(sPathName) + "zip"
    Debug.Print sDXFName
    Debug.Print sPDFName
    Debug.Print sZIPName
    ConfName = swModel.GetConfigurationNames
    index = swModel.CustomInfo2(ConfName, "Revision")
    If Len(index) = 3 Then
      index = Left(index, 2)
    End If
    sDXFName = "\\Citrix_server_1\PDF\" & sFileName & "-" & index & ".dxf"
    swApp.SetUserPreferenceToggle swDxfMapping, False
    swApp.SetUserPreferenceToggle swDxfVersion, 5
    swApp.SetUserPreferenceToggle swDxfOutputFonts, False
    swApp.SetUserPreferenceToggle swDxfMappingFileIndex, False
    swApp.SetUserPreferenceToggle swDxfOutputLineStyles, True
    swApp.SetUserPreferenceToggle swDxfOutputNoScale, True
    swApp.SetUserPreferenceToggle swDXFDontShowMap, False
    swApp.SetUserPreferenceToggle swDxfExportSplinesAsSplines, False
    bRet = swModel.SaveAs4(sDXFName, _
    swSaveAsCurrentVersion, _
    swSaveAsOptions_Silent, _
            nErrors, _
            nWarnings)
    Debug.Print bRet
    If bRet = False Then
        nRetval = swApp.SendMsgToUser2("Problems saving file.", swMbWarning, swMbOk)
    End If
    sPDFName = "\\Citrix_server_1\PDF\" & sFileName & "-" & index & ".pdf"
    swApp.SetUserPreferenceToggle swDXFDontShowMap, bShowMap
    swApp.SetUserPreferenceToggle swPDFExportInColor, False
    swApp.SetUserPreferenceToggle swPDFExportEmbedFonts, True
    swApp.SetUserPreferenceToggle swPDFExportHighQuality, True
    swApp.SetUserPreferenceToggle swPDFExportPrintHeaderFooter, False
    swApp.SetUserPreferenceToggle swPDFExportUseCurrentPrintLineWeights, True
    bRet = swModel.SaveAs4(sPDFName, swSaveAsCurrentVersion, swSaveAsOptions_Silent, nErrors, nWarnings)
    If bRet = False Then
        nRetval = swApp.SendMsgToUser2("Probleme mit dem Speichern des PDFs", swMbWarning, swMbOk)
    End If
    sZIPName = "\\Citrix_server_1\PDF\" & sFileName & "-" & index & ".zip"
    ShellX (Environ("ProgramFiles") & "\7-Zip\7z.exe a -tzip " & Chr(34) & sZIPName & Chr(34) & " " & Chr(34) & sDXFName & Chr(34))
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.DeleteFile sDXFName, False
    End Sub

Private Function ohnePfad(mitPfad As String) As String
  '
  Dim intCounter As Integer

  ' Parse the string backwards
  For intCounter = Len(mitPfad) To 1 Step -1
    ' Short-circuit when we reach the slash
    If Mid(mitPfad, intCounter, 1) = "\" Then
      Exit For
    End If
  Next intCounter
  ' Return the value
  ohnePfad = Right(mitPfad, Len(mitPfad) - intCounter)
End Function

'--------------------------------------------------------------
' Public Function ShellX()
'  Programm starten, warten, ExitCode bestimmen
'  Quelle: http://vb-tec.de/xshell.htm
'--------------------------------------------------------------
Public Function ShellX( _
      ByVal PathName As String, _
      Optional ByVal WindowStyle As Long = vbMinimizedFocus, _
      Optional ByVal Events As Boolean = True _
      ) As Long

  'Deklarationen:
  Const STILL_ACTIVE = &H103&
  Const PROCESS_QUERY_INFORMATION = &H400&
  Dim ProcId As Long
  Dim ProcHnd As Long

  'Prozess-Handle holen:
  ProcId = Shell(PathName, WindowStyle)
  ProcHnd = OpenProcess(PROCESS_QUERY_INFORMATION, True, ProcId)

  'Auf Prozess-Ende warten:
  Do
      If Events Then DoEvents
      GetExitCodeProcess ProcHnd, ShellX
  Loop While ShellX = STILL_ACTIVE

  'Aufräumen:
  CloseHandle ProcHnd
End Function

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

---

Den ersten Teil kannst du auf alle Fälle erschlagen. Ich habe hier mal so was ähnliches gebraucht für eine Zeichnungs-PDF mit dem Namen der Artikelnummer. Dabei haben mir hier die Leute sachkundig unter die Arme gegriffen. Wenn du es abwandelst, kannst du das speichern unter deinem Namen als dxf realisieren. Nur mit dem 2. Teil (Änderungsindex) hätte ich keine Idee. Aber das muss nicht viel heißen, da gibts zum Glück hier ja richtige Profis! 

------------------
Viele Grüße, THSEFA    

[Diese Nachricht wurde von THSEFA am 05. Dez. 2008 editiert.]

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

---

Vielleicht ein bischen offtopic:

Macht Ihr solche Makros selber? Es braucht doch einiges an Programmierkenntis. Oder machen das die Reseller, sonstige Softwareschmiden ?

Gruß
Lothar

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

---

Hallo Lothar,

Hier gibt es einiges an Makros zu finden, welche ev.
leichen Anpassungen für den entsprechenden Anwendungszweck benötigen.

Ob Softwarebude oder selber, irgend jemand muss den Gehirnschmalz aufwenden. Mit den Beispielen
kann man aber einiges lernen.

Gruss
Mike

------------------

The Power Of Dreams

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

---

Ich habe mir die Beispiele aus der API-Hilfe angeschaut und entsprechend abgewandelt.

Gruß, Klaus.

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