Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  SolidWorks
  Teil als DXF speichern als Makro

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für SOLIDWORKS
  
SolidCAM auf der HERMLE HAUSAUSSTELLUNG 2024
Autor Thema:  Teil als DXF speichern als Makro (5100 mal gelesen)
Spirou85
Mitglied
Konstruktuer und CAD-Betreuer


Sehen Sie sich das Profil von Spirou85 an!   Senden Sie eine Private Message an Spirou85  Schreiben Sie einen Gästebucheintrag für Spirou85

Beiträge: 70
Registriert: 01.12.2014

HP ZBook 15 G5
Intel Xeon 2,9 GHz - 32GB Ram
NVIDIA Quadro P2000M
Windows 10 Pro 64Bit Version 1809
Build 17763.1098
SWX2020-64Bit-SP1.0
MaxxDB 2020 SP0.06
DraftSight Enterprise 2019 x64 SP3
3DCONNEXION SpaceMouse Enterprise mit CadMouse

erstellt am: 01. Dez. 2014 11:59    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Zusammen,

bei uns werden Teile zur Weiterverarbeitung auf einer Brennschneidmaschine als DXF gespeichert. Der Name ist in den Dateieigenschaften abgelegt. Auch der Zielpfad lässt sich aus diesem Namen ermitteln. Eigenschaft auslesen und Pfad ermitteln funktioniert schon. Auch eine Prüfung ob etwas ausgewählt wurde. Mir fehlt noch eine Prüfung ob das Ausgewählte eine Fläche ist, und den Aufruf des Speicherns.
Die normale SaveAs- Funktion beendet mit Fehler 256 (swFileSaveAsInvalidFileExtension).
Gibt es hier eine spezielle Funktion, und wie kann ich Prüfen ob der Benutzer eine Fläche vor Aufruf des Makros ausgewählt hat?

------------------
Viele Grüße aus Brackenheim

Lars Pauly

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

StefanBerlitz
Guter-Geist-Moderator
IT Admin (CAx)



Sehen Sie sich das Profil von StefanBerlitz an!   Senden Sie eine Private Message an StefanBerlitz  Schreiben Sie einen Gästebucheintrag für StefanBerlitz

Beiträge: 8756
Registriert: 02.03.2000

SunZu sagt:
Analysiere die Vorteile, die
du aus meinem Ratschlag ziehst.
Dann gliedere deine Kräfte
entsprechend und mache dir
außergewöhnliche Taktiken zunutze.

erstellt am: 01. Dez. 2014 13:02    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Spirou85 10 Unities + Antwort hilfreich

Hallo Lars,

und willkommen im SolidWorks-Brett auf CAD.de 

Versuch statt dem SaveAs lieber den Call PartDoc::ExportToDWG2, dazu ist in der API Hilfe auch ein Beispiel (Export Part to DWG Example). Als Endung dann im Pfad der Zieldatei eben .dxf einstellen, dann sollte das klappen.

Ciao,
Stefan

------------------
Inoffizielle deutsche SolidWorks Hilfeseite    http://solidworks.cad.de

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

Spirou85
Mitglied
Konstruktuer und CAD-Betreuer


Sehen Sie sich das Profil von Spirou85 an!   Senden Sie eine Private Message an Spirou85  Schreiben Sie einen Gästebucheintrag für Spirou85

Beiträge: 70
Registriert: 01.12.2014

HP ZBook 15 G5
Intel Xeon 2,9 GHz - 32GB Ram
NVIDIA Quadro P2000M
Windows 10 Pro 64Bit Version 1809
Build 17763.1098
SWX2020-64Bit-SP1.0
MaxxDB 2020 SP0.06
DraftSight Enterprise 2019 x64 SP3
3DCONNEXION SpaceMouse Enterprise mit CadMouse

erstellt am: 01. Dez. 2014 17:13    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Stefan,

vielen Dank für den Tipp. Das habe ich gesucht. Auf die Idee nach was mit "Export" zu suchen bin ich nicht gekommen. Hab das in den Code eingebaut und es funktioniert. Der Dateiname bekommt zwar ein " (Entity_0)" vor der Endung angehängt, und ich hab nicht geschafft das weg zu bekommen, aber ich benenne das Teil dann einfach um, so wie ich den Namen haben will. Bloss die Prüfung ob eine Fläche ausgewählt wurde bekomme ich nicht hin. Mit dem "SelectionMgr" kann ich schon prüfen ob überhaupt etwas ausgewählt wurde.
Versuche ich mit "GetSelectedObject3" dies einem "Face2"-Objekt zuzuornen erhalte ich einen Laufzeitfehler (Typen unverträglich). ist ja auch klar, da es verschiedene Typen sind. Gibt es da auch Funktionen?

------------------
Viele Grüße aus Brackenheim

Lars Pauly

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

Luechinger
Mitglied
Ingenieur + CAD-Admin


Sehen Sie sich das Profil von Luechinger an!   Senden Sie eine Private Message an Luechinger  Schreiben Sie einen Gästebucheintrag für Luechinger

Beiträge: 71
Registriert: 30.07.2008

Win 7 64bit
HP Elitebook 8740W
8 GB Ram
Solidworks 2012 SP4 (64bit)
ProE WF4 M140 (64bit)
Stools 2012

erstellt am: 01. Dez. 2014 17:33    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Spirou85 10 Unities + Antwort hilfreich

Hallo Zusammen

Ich hänge mich hier gleich mal mit ran.
Auch ich möchte DXF per Makro in ein vorgegebenes Verzeichnis und mit einem vorgegebenen Dateinamen speichern. Soweit so gut und wenig problematisch. Nur möchte ich das gleiche Verhalten, wie wenn man Speichern unter wählt. Soll heissen bei Blechteilen automatisch die Abwicklung und dann den DXF Bereinigungsassistenten und bei allen anderen Teilen erst die Auswahl der Fläche und dann den Assistenten.

Kennt da jemand einen Weg?

Gruss

David

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

Luechinger
Mitglied
Ingenieur + CAD-Admin


Sehen Sie sich das Profil von Luechinger an!   Senden Sie eine Private Message an Luechinger  Schreiben Sie einen Gästebucheintrag für Luechinger

Beiträge: 71
Registriert: 30.07.2008

Win 7 64bit
HP Elitebook 8740W
8 GB Ram
Solidworks 2012 SP4 (64bit)
ProE WF4 M140 (64bit)
Stools 2012

erstellt am: 01. Dez. 2014 17:44    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Spirou85 10 Unities + Antwort hilfreich

Hallo Spirou85

Also mit GetSelectedObject3 sollte das gehen

Probiers mal so:

If swSelMgr.GetSelectedObjectType3(1) <> swSelFACES Then (oder natürlich mit = je nach Vorliebe...)

Gruss

David

PS: Ich würde vorher noch prüfen ob nur 1 Fläche ausgewählt ist, sonst 

[Diese Nachricht wurde von Luechinger am 01. Dez. 2014 editiert.]

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

Spirou85
Mitglied
Konstruktuer und CAD-Betreuer


Sehen Sie sich das Profil von Spirou85 an!   Senden Sie eine Private Message an Spirou85  Schreiben Sie einen Gästebucheintrag für Spirou85

Beiträge: 70
Registriert: 01.12.2014

HP ZBook 15 G5
Intel Xeon 2,9 GHz - 32GB Ram
NVIDIA Quadro P2000M
Windows 10 Pro 64Bit Version 1809
Build 17763.1098
SWX2020-64Bit-SP1.0
MaxxDB 2020 SP0.06
DraftSight Enterprise 2019 x64 SP3
3DCONNEXION SpaceMouse Enterprise mit CadMouse

erstellt am: 02. Dez. 2014 08:04    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Luechinger, oder David?

Du kannst mich auch mit meinem Namen anschreiben. Auf dem Nachhauseweg kam mir die Idee, die Flächenprüfung mit "OnError Goto" abzufangen. Werde aber mal Deinen Tipp probieren, da "OnError Goto" nicht sehr elegant ist. Dein Problem würde ich lösen, indem Du prüfst ob es eine Blechteil ist (mit "GetBendState"). Bei Blechteil einfach die Abwicklung exportieren, wenn kein Blechteil, dann prüfen ob Fläche ausgewählt und dies exportieren. Wenn keine Fläche ausgewählt Meldung an Benutzer. Oder falls das geht den Benutzer noch die Fläche auswählen lassen. Vielleicht kann man den "Speichern Unter"-Dialog aufrufen wenn es kein Blechteil ist mit vorgegebenem Pfad und Namen. Hab ich jedoch noch keine Erfahrung mit.

------------------
Viele Grüße aus Brackenheim

Lars Pauly

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

StefanBerlitz
Guter-Geist-Moderator
IT Admin (CAx)



Sehen Sie sich das Profil von StefanBerlitz an!   Senden Sie eine Private Message an StefanBerlitz  Schreiben Sie einen Gästebucheintrag für StefanBerlitz

Beiträge: 8756
Registriert: 02.03.2000

SunZu sagt:
Analysiere die Vorteile, die
du aus meinem Ratschlag ziehst.
Dann gliedere deine Kräfte
entsprechend und mache dir
außergewöhnliche Taktiken zunutze.

erstellt am: 02. Dez. 2014 08:09    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Spirou85 10 Unities + Antwort hilfreich

Hallo David,

Zitat:
Original erstellt von Luechinger:
Soll heissen bei Blechteilen automatisch die Abwicklung und dann den DXF Bereinigungsassistenten und bei allen anderen Teilen erst die Auswahl der Fläche und dann den Assistenten.

Ich glaube nicht, dass das irgendwo so automatisch per API funktionieren wird, dass musst du schon Schritt für Schritt selber reinprogrammieren. D.h. erst ermitteln, ob es sich um ein Blechteil handelt, wenn ja vielleicht PartDoc::ExportFlatPatternView + PartDoc::SaveAs die Abwicklung als DF speichern, bei einem Nicht-Blechteil würde ich den Weg über PartDoc::ExportToDWG2 versuchen.

Wofür ihr eine Fläche vorwählen wollt ist mir noch nicht ganz klar, außer dass ihr damit ausrechnen wollt, wie ihr die Ausrichtung setzen müsst, dass die Normale der Ansicht auf die gewählte Fläche zeigt. wäre mir persönlich zu viel Arbeit, wenn es eh ein "interaktives" Makro sein soll, dass mit Benutzereingriff arbeitet, soll der vorher das Modell in die Ansicht bringen, die er exportiert haben will und ihr nehmt dann die aktuelle Ansicht zum Expprtieren 

Ciao,
Stefan

------------------
Inoffizielle deutsche SolidWorks Hilfeseite    http://solidworks.cad.de

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

Lutz Federbusch
Ehrenmitglied V.I.P. h.c.
Dipl.-Ing. Maschinenbau



Sehen Sie sich das Profil von Lutz Federbusch an!   Senden Sie eine Private Message an Lutz Federbusch  Schreiben Sie einen Gästebucheintrag für Lutz Federbusch

Beiträge: 3094
Registriert: 03.12.2001

alle SW seit 97+
AutoCAD2016-2022
ERP ProAlpha + CA-Link
Intel Core i7-7820K 32GB
Win10x64 Quadro K5000
SpacePilot

erstellt am: 02. Dez. 2014 11:40    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Spirou85 10 Unities + Antwort hilfreich

Am einfachsten wäre es doch, in dem Teil eine eindeutige, erkennbare und immer gleich benannte Konfiguration für die Abwicklung zu erstellen und diese Konfiguration zu aktivieren, bevor exportiert wird (Meist hat man doch die Konfiguration für die Zeichnung ohnehin schon). Wozu muß man dann noch eine Fläche ausgewählt haben?!
DXF läßt sich mittels SaveAs gut und verläßlich speichern inkl. Abbildungsdatei.

------------------
Lutz Federbusch
Mein Gästebuch
Der Mensch, Herr oder Sklave der Technik?

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

Luechinger
Mitglied
Ingenieur + CAD-Admin


Sehen Sie sich das Profil von Luechinger an!   Senden Sie eine Private Message an Luechinger  Schreiben Sie einen Gästebucheintrag für Luechinger

Beiträge: 71
Registriert: 30.07.2008

Win 7 64bit
HP Elitebook 8740W
8 GB Ram
Solidworks 2012 SP4 (64bit)
ProE WF4 M140 (64bit)
Stools 2012

erstellt am: 02. Dez. 2014 17:02    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Spirou85 10 Unities + Antwort hilfreich

Hallo Zusammen

Ja da habe ich mich wohl unklar ausgedrückt.
Dass ich dass Schritt für Schritt selber programmieren muss (sprich erkennen ob Blechteil etc.) ist klar und auch kein Problem.

Was ich will ist den DXF Bereinigungsassistenten aufrufen um das DXF zu prüfen und evtl Optimierungen vorzunehmen. Beim Speichern unter (manuell) macht Solidworks die Unterscheidung Blechteile oder nicht automatisch und bringt nachher den Assistenten. Am einfachsten wäre dies realisierbar, wenn ich denn Speichern unter Dialog mit vorgegebenem Dateinamen und Pfad aufrufen könnte. Nur weiss ich keinen Weg den Dialog so aufzurufen.

Warum wollen wir die Fläche? Also das ist einfach: Viele unserer Blechteile (alle ohne Abkantungen) sind keine Blechteile im Sinn von Solidworks (sodern normale Extrusionen). Da weiss Solidworks nicht von welcher Fläche die Kontur für das DXF übernommen werden soll. Die Auswahl über die Fläche ist für den Bediener am einfachsten und analog der manuellen Solidworks Routine.

Gruss

David

[Diese Nachricht wurde von Luechinger am 02. Dez. 2014 editiert.]

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

StefanBerlitz
Guter-Geist-Moderator
IT Admin (CAx)



Sehen Sie sich das Profil von StefanBerlitz an!   Senden Sie eine Private Message an StefanBerlitz  Schreiben Sie einen Gästebucheintrag für StefanBerlitz

Beiträge: 8756
Registriert: 02.03.2000

SunZu sagt:
Analysiere die Vorteile, die
du aus meinem Ratschlag ziehst.
Dann gliedere deine Kräfte
entsprechend und mache dir
außergewöhnliche Taktiken zunutze.

erstellt am: 03. Dez. 2014 08:12    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Spirou85 10 Unities + Antwort hilfreich

Hallo David,

Zitat:
Original erstellt von Luechinger:
Was ich will ist den DXF Bereinigungsassistenten aufrufen um das DXF zu prüfen und evtl Optimierungen vorzunehmen

Wüsste ich auch nicht wie das geht, vielleicht kommst du da über einen der vielen hunderte Optionen via ModelDocExtension::RunCommand dran, da kannst du ja mal probieren und rumsuchen.

Zitat:
Original erstellt von Luechinger:
Am einfachsten wäre dies realisierbar, wenn ich denn Speichern unter Dialog mit vorgegebenem Dateinamen und Pfad aufrufen könnte. Nur weiss ich keinen Weg den Dialog so aufzurufen.

Ich glaube nicht, dass das möglich ist, die allermeisten Dialoge, Propertymanager, Einstellungen etc. lassen sich nicht in den eigenen Makrofluss einbauen. Wenn man bestimmte Dialoge nur aufrufen will hilft manchmal das RunCommand (wobei das suchen nach der richtigen Option manchmal mühselig sein kann), die Alternative ist manchmal das gute alte SendKeys dafür zu nutzen.

Zitat:
Original erstellt von Luechinger:
Warum wollen wir die Fläche? Also das ist einfach: Viele unserer Blechteile (alle ohne Abkantungen) sind keine Blechteile im Sinn von Solidworks (sodern normale Extrusionen). Da weiss Solidworks nicht von welcher Fläche die Kontur für das DXF übernommen werden soll. Die Auswahl über die Fläche ist für den Bediener am einfachsten und analog der manuellen Solidworks Routine.

Dann könntest du die vorauswählen lassen oder deinen eigenen Propertymanager/Dialog dafür bauen und die selektierten Flächen dann mit dem oben angesprochenen PartDoc::ExportToDWG2 mit der Action swExportToDWG_ExportSelectedFacesOrLoops ausführen, das sollte funktionieren.

Über ein lauffähiges Makro würde sich hier bestimmt der ein oder andere freuen, wenn ihr da also was gebastelt bekommt wäre es schön, wenn ihr das hier veröffentlichen könntet 

Ciao,
Stefan

------------------
Inoffizielle deutsche SolidWorks Hilfeseite    http://solidworks.cad.de

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

Spirou85
Mitglied
Konstruktuer und CAD-Betreuer


Sehen Sie sich das Profil von Spirou85 an!   Senden Sie eine Private Message an Spirou85  Schreiben Sie einen Gästebucheintrag für Spirou85

Beiträge: 70
Registriert: 01.12.2014

HP ZBook 15 G5
Intel Xeon 2,9 GHz - 32GB Ram
NVIDIA Quadro P2000M
Windows 10 Pro 64Bit Version 1809
Build 17763.1098
SWX2020-64Bit-SP1.0
MaxxDB 2020 SP0.06
DraftSight Enterprise 2019 x64 SP3
3DCONNEXION SpaceMouse Enterprise mit CadMouse

erstellt am: 03. Dez. 2014 09:33    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Zusammen,

auch bei uns sind nicht alle Brennteile als Blech erstellt. Auch haben wir Brennteile aus Tränenblech, die nicht symetrisch sind, und da ist die Seite von der die DXF erzeugt wird wichtig (Tränen müssen auf der Brennschneidmaschine nach unten zeigen). Daher das auswählen der Fläche. Hier nun das Makro, welches nun läuft. Die von Stefan angegebene PartDoc::ExportToDWG2-Funktion gibt es unter SWX2013 anscheinend nicht. In meiner API-Hilfe habe ich nur die verwendete PartDoc::ExportTODWG-Funktion gefunden die ich auch verwendet habe. Bei uns steht die Brennteilbezeichnung in der Eigenschaft "Desc2" und in der Eigenschaft "PWDB_field9" ist der String "Brennteil" enthalten wenn es ein Brennteil ist. Der Zielpfad lässt sich aus der Auftragsnummer berechnen. Ihr werdet wahrscheinlich einiges rauswerfen und ersetzen um es an Eure Bedürfnisse anzupassen.

Option Explicit
' **********************************************************************
' * Makro speichert ein Teil als DXF-Datei ab abhängig von dem
' * Inhalt in Eigenschaft "Desc2"
' *
' * 01.12.2014 Lars Pauly
' **********************************************************************


Sub main()
   
    Dim SwApp As SldWorks.SldWorks          'Zugriff auf SolidWorks
    Dim PartDoc As SldWorks.ModelDoc2      'Zugriff auf Aktuelles Dokument
    Dim swSelMgr As SldWorks.SelectionMgr  'Zugriff auf Auswahl des Benutzers
   
    Dim sPfad As String                    'Zielpfad der Brennteildatei
    Dim sBenenn2 As String                  'Inhalt der Dokumenteneigenschaft "Desc2"
    Dim sFertArt As String                  'Inhalt der Dokumenteneigenschaft "PWDB_field9"
    Dim sAufNr As String                    'Inhalt der Dokumenteneigenschaft "Field1"
    Dim sModelPfad As String                'Pfad des Dokuments (wird für Export benötigt)
   
    Dim nI As Long                          'Zählvariable
    Dim nAufNr As Long                      'Auftragsnummer als Zahl
   
    Dim fs As Variant                      'Zugriff auf FileSystemObject
    Dim fo As Variant                      'Zugriff auf Ordner
    Dim fos As Variant                      'Zugriff auf Unterordner
    Dim foi As Variant                      'Für den Ordnervergleich
    Dim nTeiler As Long                    'Teiler zur Ermittlung des Zielpfades
    Dim sVerz As String                    'Hilfsvariable zur Zielpfadermittlung
    Dim sConfigNam As String                'Name der aktiven Konfiguration
    Dim bFehler As Boolean                  'Fehlermerker (True wenn Fehler aufgetreten)
    Dim sFehler As String                  'Fehlerausgabe
   
'Variablen zum merken der DXF-Einstellungen
    Dim nDXfVersion As Long
    Dim nSchriftarten As Long
    Dim nLinienarten As Long
    Dim bAbbildungsdatei As Boolean
    Dim bAbbilddatanzeigen
    Dim nMassstab As Long
    Dim bPunktVerschm As Boolean
    Dim dPunktAbstand As Double
    Dim bHighQuality As Boolean
    Dim bSplines As Boolean
    Dim nMehrBlatt As Long
    Dim bPapierbereich As Boolean
    Dim bVersteckteLayer As Boolean
    Dim bLayerwarnung As Boolean
   
'SolidWorks-Objekt erstellen und mit Aktivem Dokument verbinden
    Set SwApp = Application.SldWorks
    Set PartDoc = SwApp.ActiveDoc
   
    If (PartDoc.GetType <> swDocPART) Then
        ' wenn keine Teil aktiv wird das Makro wieder beendet
        Call MsgBox("Aktuelles Dokument ist kein Teil!", vbCritical + vbOKOnly, "Fehler !")
        Exit Sub
    End If
   
    'Fehlermerker initialisieren
    bFehler = False
    sFehler = ""
    'Aktive Konfiguration ermitteln
    sConfigNam = PartDoc.ConfigurationManager.ActiveConfiguration.Name
   
    'Benennung 2, Fertigungsart und Auftragsnummer aus Eigenschaften ermitteln
    sBenenn2 = CStr(PartDoc.CustomInfo2(sConfigNam, "Desc2"))
    sFertArt = CStr(PartDoc.CustomInfo2(sConfigNam, "PWDB_field9"))
    sAufNr = CStr(PartDoc.CustomInfo2(sConfigNam, "Field1"))
    ' In Auftragsnummer "/" und "_" durch "-" ersetzen
    nI = InStr(1, sAufNr, "/", vbBinaryCompare)
    If nI = 0 Then
        nI = InStr(1, sAufNr, "_", vbBinaryCompare)
    End If
    If nI > 0 Then
        sAufNr = Left(sAufNr, nI - 1) & "-" & Mid(sAufNr, nI + 1)
    End If
   
    ' Ist SSI-Auftragnummer vorangestellt
    If Len(sAufNr) = 11 And InStr(1, sAufNr, "-", vbBinaryCompare) = 6 Then
        ' Kurz-Auftragsnummer extrahieren
        sAufNr = Right(sAufNr, 5)
    End If
    ' Ist Reklamationsnummer hinter Auftragsnummer
    If Len(sAufNr) = 10 And InStr(1, sAufNr, "-", vbBinaryCompare) = 6 Then
        ' Kurz-Auftragsnummer extrahieren
        sAufNr = Left(sAufNr, 5)
    End If
    ' Länge der Auftragsnummer 5
    If Len(sAufNr) <> 5 Then
        If sFehler <> "" Then sFehler = sFehler & vbCrLf
        sFehler = sFehler & "Bei aktuellem Dokument entspricht die in der Datei abgelegte Auftragsnummer nicht dem Kurz-Format!"
        bFehler = True
    End If
    ' Ist Auftragsnummer eine Zahl
    If IsNumeric(sAufNr) = True Then
        nAufNr = CLng(sAufNr)
    Else
        If sFehler <> "" Then sFehler = sFehler & vbCrLf
        sFehler = sFehler & "Bei aktuellem Dokument ist die in der Datei abgelegte Auftragsnummer keine Zahl!"
        bFehler = True
    End If
   
    'Inhalt in Benennung 2 ?
    If sBenenn2 = "" Then
        If sFehler <> "" Then sFehler = sFehler & vbCrLf
        sFehler = sFehler & "Bei aktuellem Dokument ist in Benennung 2 keine Brennteilbezeichnung eingetragen!"
        bFehler = True
    End If
    'Erste 5 Stellen in Benennung 2 gleich Auftragsnummer ?
    If Left(sBenenn2, 5) <> sAufNr And sBenenn2 <> "" Then
        If sFehler <> "" Then sFehler = sFehler & vbCrLf
        sFehler = sFehler & "Bei aktuellem Dokument entspricht die Brennteilbezeichnung nicht der Auftragsnummer!"
        bFehler = True
    End If
   
    'Zeichen in Benennung 2 > 5
    If Len(sBenenn2) < 5 And sBenenn2 <> "" Then
        If sFehler <> "" Then sFehler = sFehler & vbCrLf
        sFehler = sFehler & "Bei aktuellem Dokument entspricht die Brennteilbezeichnung nicht den Vorgaben!"
        bFehler = True
    End If
   
    'in Fertigungsart "Brennteil" eingetragen?
    If InStr(1, sFertArt, "brennteil", vbTextCompare) < 1 Then
        If sFehler <> "" Then sFehler = sFehler & vbCrLf
        sFehler = sFehler & "Bei aktuellem Dokument ist der Brennteilmerker nicht gesetzt!"
        bFehler = True
    End If
   
    'Wenn Fehler aufgetreten dann Fehlertext ausgeben und Sub verlassen
    If bFehler = True Then
        Call MsgBox(sFehler, vbCritical + vbOKOnly, "Fehler !")
        Exit Sub
    End If
   
    'Ist Fläche ausgewählt?
    Set swSelMgr = PartDoc.SelectionManager
    If swSelMgr Is Nothing Then
        Call MsgBox("Nichts ausgewählt, bitte vor Aufruf Fläche auswählen!", vbCritical + vbOKOnly, "Fehler !")
        Exit Sub
    End If
    If swSelMgr.GetSelectedObjectCount2(-1) > 1 Then
        Call MsgBox("Mehr als eine Fläche ausgewählt, bitte vor Aufruf nur eine Fläche auswählen!", vbCritical + vbOKOnly, "Fehler !")
        Exit Sub
    End If
    If swSelMgr.GetSelectedObjectType3(1, -1) <> swSelFACES Then
        Call MsgBox("Keine Fläche ausgewählt, bitte vor Aufruf Fläche auswählen!", vbCritical + vbOKOnly, "Fehler !")
        Exit Sub
    End If
   
   
    ' Pfad von Auftragsordner ermitteln
    sPfad = "P:\_DNC\Microstep\Aufträge\"
    nTeiler = nAufNr \ 1000
    sPfad = sPfad + CStr(nTeiler * 1000)
    sPfad = sPfad + "-"
    sPfad = sPfad + CStr(((nTeiler + 1) * 1000) - 1)
    sPfad = sPfad + "\"
    nTeiler = nAufNr \ 50
    If Right(CStr(nTeiler * 50), 3) = "000" Then
        sPfad = sPfad + CStr(nTeiler * 50)
        sPfad = sPfad + "-"
        sPfad = sPfad + CStr(((nTeiler + 1) * 50))
    Else
        If Right(CStr(nAufNr), 2) = "50" Or Right(CStr(nAufNr), 2) = "00" Then
            sPfad = sPfad + CStr(((nTeiler - 1) * 50) + 1)
            sPfad = sPfad + "-"
            sPfad = sPfad + CStr((nTeiler * 50))
        Else
            sPfad = sPfad + CStr((nTeiler * 50) + 1)
            sPfad = sPfad + "-"
            sPfad = sPfad + CStr(((nTeiler + 1) * 50))
        End If
    End If
    'FileSystemObject anlegen
    Set fs = CreateObject("Scripting.FileSystemObject")
    ' Verzeichnisbezeichnung ermitteln
    If fs.FolderExists(sPfad) = True Then
    ' Übergeordneter Ordner existiert
        Set fo = fs.GetFolder(sPfad)
        Set fos = fo.SubFolders
        sVerz = "Keine"
        For Each foi In fos
            If Left(foi.Name, 5) = CStr(nAufNr) Then
                sVerz = foi.Name
            End If
        Next foi
        If sVerz = "Keine" Then
            sVerz = sAufNr
            fs.CreateFolder (sPfad + "\" + sVerz)
            Call MsgBox("Projektordner war im Ziellaufwerk nicht vorhanden und wurde erstellt!", vbInformation + vbOKOnly, "Ordner erstellt!")
        End If
    Else
        Call MsgBox("Im Ziellaufwerk ist der Ordner " & Chr(34) & sPfad & Chr(34) & " nicht vorhanden!", vbCritical + vbOKOnly, "Fehler !")
        Exit Sub
    End If
    sPfad = sPfad + "\" + sVerz
   
    'Exporteigenschaften sichern
    nDXfVersion = SwApp.GetUserPreferenceIntegerValue(swDxfVersion)
    nSchriftarten = SwApp.GetUserPreferenceIntegerValue(swDxfOutputFonts)
    nLinienarten = SwApp.GetUserPreferenceIntegerValue(swDxfOutputLineStyles)
    bAbbildungsdatei = SwApp.GetUserPreferenceToggle(swDxfMapping)
    bAbbilddatanzeigen = SwApp.GetUserPreferenceToggle(swDXFDontShowMap)
    nMassstab = SwApp.GetUserPreferenceIntegerValue(swDxfOutputNoScale)
    bPunktVerschm = SwApp.GetUserPreferenceToggle(swDxfEndPointMerge)
    dPunktAbstand = SwApp.GetUserPreferenceDoubleValue(swDxfMergingDistance)
    bHighQuality = SwApp.GetUserPreferenceToggle(swDXFHighQualityExport)
    bSplines = SwApp.GetUserPreferenceToggle(swDxfExportSplinesAsSplines)
    nMehrBlatt = SwApp.GetUserPreferenceIntegerValue(swDxfMultiSheetOption)
    bPapierbereich = SwApp.GetUserPreferenceToggle(swDxfExportAllSheetsToPaperSpace)
    bVersteckteLayer = SwApp.GetUserPreferenceToggle(swDXFExportHiddenLayersOn)
    bLayerwarnung = SwApp.GetUserPreferenceToggle(swDXFExportHiddenLayersWarnIsOn)
   
    'Exporteigenschaften bearbeiten
    SwApp.SetUserPreferenceIntegerValue swDxfVersion, 0                    'R12
    SwApp.SetUserPreferenceIntegerValue swDxfOutputFonts, 0                'Auto-Cad-Standard
    SwApp.SetUserPreferenceIntegerValue swDxfOutputLineStyles, 1            'SolidWorks Custom Styles
    SwApp.SetUserPreferenceToggle swDxfMapping, False                      'Abbildungsdatei nicht verwenden
    SwApp.SetUserPreferenceToggle swDXFDontShowMap, True                    'Abbildungsdatei nicht anzeigen
    SwApp.SetUserPreferenceIntegerValue swDxfOutputNoScale, 1              'Massstab 1:1 verwenden
    SwApp.SetUserPreferenceToggle swDxfEndPointMerge, True                  'Punkte verschmelzen
    SwApp.SetUserPreferenceDoubleValue swDxfMergingDistance, 0.5            'Punktabstand
    SwApp.SetUserPreferenceToggle swDXFHighQualityExport, True              'Hochqualitativer Export
    SwApp.SetUserPreferenceToggle swDxfExportSplinesAsSplines, False        'Splines als Polylinien
    SwApp.SetUserPreferenceIntegerValue swDxfMultiSheetOption, 0            'Nur das aktive Blatt exportieren
    SwApp.SetUserPreferenceToggle swDxfExportAllSheetsToPaperSpace, False  'Nicht in Papierbereich
    SwApp.SetUserPreferenceToggle swDXFExportHiddenLayersOn, True          'Versteckte Layer exportieren
    SwApp.SetUserPreferenceToggle swDXFExportHiddenLayersWarnIsOn, True    'Layerwarnung weiter anzeigen
   
    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
    'Beim Speichern wird " (Entity_0)" an den Namen angehängt. Deshalb Datei umbenennen
    If fs.FileExists(sPfad & "\" & sBenenn2 & " (Entity_0).DXF") = True Then
        If fs.FileExists(sPfad & "\" & sBenenn2 & ".DXF") = True Then
            'Wenn Zieldatei schon existiert, diese vorher löschen
            fs.DeleteFile sPfad & "\" & sBenenn2 & ".DXF"
        End If
        'MoveFile zum Umbenennen verwenden
        fs.MoveFile sPfad & "\" & sBenenn2 & " (Entity_0).DXF", sPfad & "\" & sBenenn2 & ".DXF"
    End If
   
    'Exporteigenschaften zurücksetzen
    SwApp.SetUserPreferenceIntegerValue swDxfVersion, nDXfVersion
    SwApp.SetUserPreferenceIntegerValue swDxfOutputFonts, nSchriftarten
    SwApp.SetUserPreferenceIntegerValue swDxfOutputLineStyles, nLinienarten
    SwApp.SetUserPreferenceToggle swDxfMapping, bAbbildungsdatei
    SwApp.SetUserPreferenceToggle swDXFDontShowMap, bAbbilddatanzeigen
    SwApp.SetUserPreferenceIntegerValue swDxfOutputNoScale, nMassstab
    SwApp.SetUserPreferenceToggle swDxfEndPointMerge, bPunktVerschm
    SwApp.SetUserPreferenceDoubleValue swDxfMergingDistance, dPunktAbstand
    SwApp.SetUserPreferenceToggle swDXFHighQualityExport, bHighQuality
    SwApp.SetUserPreferenceToggle swDxfExportSplinesAsSplines, bSplines
    SwApp.SetUserPreferenceIntegerValue swDxfMultiSheetOption, nMehrBlatt
    SwApp.SetUserPreferenceToggle swDxfExportAllSheetsToPaperSpace, bPapierbereich
    SwApp.SetUserPreferenceToggle swDXFExportHiddenLayersOn, bVersteckteLayer
    SwApp.SetUserPreferenceToggle swDXFExportHiddenLayersWarnIsOn, bLayerwarnung

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

Danke nochmal für Eure Hilfen, die mir ermöglicht haben das Projekt fertig zu stellen.

------------------
Viele Grüße aus Brackenheim

Lars Pauly

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

Luechinger
Mitglied
Ingenieur + CAD-Admin


Sehen Sie sich das Profil von Luechinger an!   Senden Sie eine Private Message an Luechinger  Schreiben Sie einen Gästebucheintrag für Luechinger

Beiträge: 71
Registriert: 30.07.2008

Win 7 64bit
HP Elitebook 8740W
8 GB Ram
Solidworks 2012 SP4 (64bit)
ProE WF4 M140 (64bit)
Stools 2012

erstellt am: 04. Dez. 2014 13:51    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Spirou85 10 Unities + Antwort hilfreich

Hallo Zusammen

Die Funktion RunCommand kannte ich noch gar nicht. Merci Stefan, dass eröffnet neue Möglichkeiten (nicht nur für diesen Fall.)

Merci Lars fürs veröffentlichen des Makros. Find ich Immer gut, so haben alle was davon. Mein Makro werde ich wie Immer auch reinstellen.

Gruss

David

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2024 CAD.de | Impressum | Datenschutz