| | | 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
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 / zitieren --> Unities abgeben:
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)
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 / zitieren --> Unities abgeben: Nur für Spirou85
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
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 / zitieren --> Unities abgeben:
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
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 / zitieren --> Unities abgeben: Nur für Spirou85
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
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 / zitieren --> Unities abgeben: Nur für Spirou85
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
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 / zitieren --> Unities abgeben:
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)
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 / zitieren --> Unities abgeben: Nur für Spirou85
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
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 / zitieren --> Unities abgeben: Nur für Spirou85
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
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 / zitieren --> Unities abgeben: Nur für Spirou85
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)
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 / zitieren --> Unities abgeben: Nur für Spirou85
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
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 / zitieren --> Unities abgeben:
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
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 / zitieren --> Unities abgeben: Nur für Spirou85
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 >>)
|