Schoenenberger_Systeme_GmbH/dxfmakros
7
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
c3b4bf9db3becb72588c7031097bbc46f9419133
dxfmakros/tests/test_run_all.lsp
T
m.stangl 9e3e8e16ae fix(tests): Testlauf haengt nicht mehr an Export-Rueckfragen, Laufprotokoll je Test 
TEST_LINIENZUG (ebenso hmrec:stubs-aus und vsp-headless-aus) schaltete die
GUI am Ende pauschal wieder ein. Unter SSG_RUN_ALL_TESTS fragte der direkt
folgende EXPORTSIVAS dann nach Hoehen-Check/Bereinigen und der Lauf blieb
stehen. Alle drei stellen jetzt den Vorzustand von *ssg-gui-aus* wieder her.

SSG_RUN_ALL_TESTS schaltet zusaetzlich *csv-hoehencheck-fragen* und
*csv-bereinigen-vor-export* fuer den Lauf ab (unmittelbar vor jedem Export
erneut, export.lsp belegt nil beim Nachladen wieder mit T), erzwingt GUI aus
mit Warnung und stellt am Ende die Vorgaben wieder her.

Neues Laufprotokoll DXFM_LOG/testlauf_<name>.dbg je Test (Debug-Schalter
"testlauf", Standard ein): Zustand vor/nach dem Test, Fehler, Ergebnis-JSON,
Export-Schritte. Eigene Datei mit sofortigem Schreiben statt dbgopen, damit
die Module mit ihren eigenen .dbg-Dateien es nicht umlenken und bei einem
Haenger der letzte Schritt sichtbar ist.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-10-28 09:52:10 +01:00

561 lines
25 KiB
Common Lisp
Raw Blame History

;; ============================================================
;; test_run_all.lsp - Fuehrt alle LISP-Tests nacheinander aus
;;
;; Laedt und startet alle in tests/alltests.json registrierten Tests.
;; Konvention: Aus Basisname <name> leiten sich ab:
;; Datei: test_<name>.lsp
;; Befehl: TEST_<NAME>
;; Export: <name>:export-results
;;
;; Ergebnisse werden in tests/output/ gespeichert:
;; JSON: immer (<name>_results.json, via <name>:export-results)
;; DXF: wenn "save": "dxf" in alltests.json
;; DWG: wenn "save": "dwg" in alltests.json
;; keins: wenn "save" fehlt, null oder leer
;;
;; Voraussetzungen:
;; - SSG_LIB geladen
;; - Umgebungsvariable DXFMAKRO gesetzt
;;
;; Aufruf in BricsCAD:
;; (load (strcat (getenv "DXFMAKRO") "/tests/test_run_all.lsp"))
;; SSG_RUN_ALL_TESTS
;;
;; Jedes Testmodul laeuft in einer eigenen, neuen Zeichnung (statt die
;; aktuelle zu leeren/wiederzuverwenden). Der Modus wird ueber den
;; aufgerufenen Befehl bestimmt (keine interaktive Rueckfrage):
;; SSG_RUN_ALL_TESTS_OFFEN / SSG_RUN_ALL_TESTS (Kontroll-Modus, Default):
;; Zeichnung wird gespeichert, auf den Inhalt gezoomt und bleibt als
;; Tab offen - kein CSV/Sivas-Export. Am Ende sind alle Testzeichnungen
;; gleichzeitig offen und koennen direkt begutachtet werden. CSV/Sivas-
;; Export danach bei Bedarf manuell ueber TEST_EXPORT_ALL
;; (tests/test_export_all.lsp).
;; SSG_RUN_ALL_TESTS_EXPORT (Automatik-Modus): Zeichnung wird gespeichert,
;; per EXPORTCSV/EXPORTSIVAS exportiert und danach sofort wieder
;; geschlossen - kompletter Lauf ohne manuellen Zusatzschritt, aber
;; ohne gleichzeitige visuelle Kontrolle aller Zeichnungen am Ende.
;; ============================================================
(vl-load-com)
;; --- Auf Fertigstellung einer asynchron geschriebenen Datei warten ---
;; csv:run-export startet Python per startapp (fire-and-forget). Pollt
;; bis die Datei existiert und ihre Groesse ueber ein Intervall stabil
;; bleibt, oder bis timeout-sec erreicht ist. Rueckgabe: T bei Erfolg.
;; (Analog zu export_all:wait-for-file aus tests/test_export_all.lsp,
;; hier lokal, da hier direkt auf der offenen Zeichnung exportiert wird
;; statt auf einer bereits gespeicherten Datei.)
(defun testrun:wait-for-file (path timeout-sec / elapsed size1 size2 done)
(setq elapsed 0.0 done nil)
(while (and (not done) (< elapsed timeout-sec))
(if (findfile path)
(progn
(setq size1 (vl-file-size path))
(command "_.DELAY" 400)
(setq size2 (vl-file-size path))
(if (and size1 size2 (= size1 size2) (> size1 0))
(setq done T)
)
)
(command "_.DELAY" 400)
)
(setq elapsed (+ elapsed 0.4))
)
done
)
;; --- Hilfsfunktion: String-Wert aus JSON-Objekt-Zeile lesen ---
;; Sucht "key": "value" in obj-str und gibt value zurueck.
;; Rueckgabe: String (nicht leer) oder nil (key fehlt, null, leer).
;; ------------------------------------------------------------
;; Laufprotokoll je Test (Debug-Schalter "testlauf", Standard EIN)
;; ------------------------------------------------------------
;; DXFM_LOG/testlauf_<name>.dbg - eine Datei je Test, bei jedem Lauf neu.
;; Bewusst NICHT ueber dbgopen/*dbg-path*: die getesteten Module oeffnen und
;; schliessen dort ihre eigenen .dbg-Dateien (vfl_modus1.dbg ...) und wuerden
;; das Protokoll mitten im Test umlenken. Jede Zeile wird SOFORT angehaengt
;; (kein Puffer) - haengt ein Test, steht der letzte erreichte Schritt drin.
(if (not (boundp '*testrun-log*)) (setq *testrun-log* nil))
(defun testrun:log-start (name / dir fh)
(setq *testrun-log* nil)
(if (and (car (atoms-family 1 '("DBG-SCHALTER-P"))) (dbg-schalter-p "testlauf"))
(progn
(setq dir (cond ((getenv "DXFM_LOG")) ((strcat (getenv "DXFMAKRO") "/logs"))))
(vl-mkdir dir)
(setq *testrun-log* (strcat dir "/testlauf_" name ".dbg"))
(if (setq fh (open *testrun-log* "w"))
(progn (write-line (strcat "=== TESTLAUF " name " ===") fh) (close fh))
(setq *testrun-log* nil))))
*testrun-log*)
(defun testrun:log (text / fh)
(if (and *testrun-log* (setq fh (open *testrun-log* "a")))
(progn
(write-line (strcat (if (car (atoms-family 1 '("DBG-TIMESTAMP"))) (dbg-timestamp) "")
" " text)
fh)
(close fh)))
(princ))
;; Schalter, die in einem Testlauf eine Rueckfrage ausloesen koennen.
(defun testrun:zustand ()
(strcat "GUI=" (if (and (boundp '*ssg-gui-aus*) *ssg-gui-aus*) "aus" "AN")
" hoehencheck-fragen=" (vl-princ-to-string (if (boundp '*csv-hoehencheck-fragen*) *csv-hoehencheck-fragen*))
" bereinigen=" (vl-princ-to-string (if (boundp '*csv-bereinigen-vor-export*) *csv-bereinigen-vor-export*))
" wizard=" (vl-princ-to-string (if (boundp '*vfl-wizard-mode*) *vfl-wizard-mode*))
" DWGNAME=" (getvar "DWGNAME")))
;; Dateiname ohne fuehrenden Praefix (sonst unveraendert). Gegenstueck zu
;; export:dwg-praefix, den der Export selbst vor den Namen setzt.
(defun testrun:ohne-praefix (dateiname praefix)
(if (and praefix
(/= praefix "")
(> (strlen dateiname) (strlen praefix))
(= (strcase (substr dateiname 1 (strlen praefix))) (strcase praefix)))
(substr dateiname (1+ (strlen praefix)))
dateiname))
(defun alltests:get-str(obj-str key / pat pos val-start val-end val)
(setq pat (strcat "\"" key "\": \""))
(setq pos (vl-string-search pat obj-str))
(if pos
(progn
(setq val-start (+ pos (strlen pat))) ;; 0-basiert
(setq val-end (vl-string-search "\"" obj-str val-start))
(if val-end
(progn
(setq val (substr obj-str (1+ val-start) (- val-end val-start)))
(if (> (strlen val) 0) val nil)
)
)
)
)
)
;; --- Testliste aus tests/alltests.json laden ---
;; Erwartet ein JSON-Array, je Zeile ein Objekt: { "name": "...", "save": "..." }
;; "save" kann "dxf", "dwg", null oder fehlen (= kein Speichern).
;; Rueckgabe: Liste von Assoc-Listen (("name" . "kreisel") ("save" . "dxf"))
(defun alltests:load (tests-pfad / json-datei f zeile ergebnis name save-fmt module disabled)
(setq json-datei (strcat tests-pfad "/alltests.json"))
(if (not (findfile json-datei))
(progn
(princ (strcat "\n FEHLER: " json-datei " nicht gefunden!"))
nil
)
(progn
(setq f (open json-datei "r"))
(if (null f)
(progn
(princ (strcat "\n FEHLER: Kann " json-datei " nicht oeffnen!"))
nil
)
(progn
(setq ergebnis nil)
(while (setq zeile (read-line f))
;; Jede Zeile mit "name" ist ein Test-Eintrag (ein Objekt pro Zeile)
(if (vl-string-search "\"name\"" zeile)
(progn
(setq name (alltests:get-str zeile "name"))
(setq save-fmt (alltests:get-str zeile "save"))
(setq module (alltests:get-str zeile "module"))
;; "disabled": true schaltet einen Test-Eintrag ab (JSON-Boolean,
;; daher direkte Textsuche statt alltests:get-str fuer Strings).
(setq disabled (if (vl-string-search "\"disabled\": true" zeile) "1" nil))
(if name
(setq ergebnis (cons
(list (cons "name" name) (cons "save" save-fmt)
(cons "module" module) (cons "disabled" disabled))
ergebnis))
)
)
)
)
(close f)
(reverse ergebnis)
)
)
)
)
)
;; --- Konventionsbasierte Namen aus Basisname ableiten ---
;; Gibt Assoc-Liste zurueck: datei, befehl, export-fn
(defun test-module-names (name tests-pfad)
(list
(cons "datei" (strcat tests-pfad "/test_" name ".lsp"))
(cons "befehl" (strcat "TEST_" (strcase name)))
(cons "export-fn" (read (strcat name ":export-results")))
)
)
(defun c:SSG_RUN_ALL_TESTS ( / tests-pfad tests-out-dir app auto-export
idx anz entry name save-fmt module
namen befehl datei export-fn new-doc
out-path dwg-pfad dxf-pfad old-json test-result
old-filenames csv-name sivas-name csv-pfad
sivas-pfad csv-ok sivas-ok old-filedia
praefix old-hoehencheck old-bereinigen)
(setq tests-pfad (strcat (getenv "DXFMAKRO") "/tests"))
(setq tests-out-dir (strcat tests-pfad "/output"))
(vl-mkdir tests-out-dir)
(setq app (vlax-get-acad-object))
;; Testliste aus alltests.json laden
(setq *test-module* (alltests:load tests-pfad))
(if (null *test-module*)
(progn
(princ "\n FEHLER: Keine Test-Module geladen. Abbruch.")
(exit)
)
)
(setq anz (length *test-module*))
(setq idx 0)
;; Modus bestimmen: Kontrolle (Zeichnungen bleiben offen, kein Export)
;; oder Automatik (Speichern + CSV/Sivas-Export + Schliessen je Test).
;; Die Wahl kommt ueber die Menue-Befehle SSG_RUN_ALL_TESTS_EXPORT
;; (Automatik) bzw. SSG_RUN_ALL_TESTS_OFFEN (Kontrolle), die
;; *ssg-run-all-auto-export* vorbelegen - keine interaktive Rueckfrage.
;; Ein direkter SSG_RUN_ALL_TESTS ohne Vorbelegung faellt auf den
;; nicht-destruktiven Kontroll-Modus (nil) zurueck.
(if (boundp '*ssg-run-all-auto-export*)
(progn
(setq auto-export *ssg-run-all-auto-export*)
(setq *ssg-run-all-auto-export* nil) ;; Vorauswahl nur einmal gueltig
)
(setq auto-export nil)
)
;; *export-test-override* (Lisp/export.lsp, csv:run-export) fuer die Dauer
;; des Automatik-Laufs setzen, damit c:EXPORTCSV/c:EXPORTSIVAS nach
;; tests/output statt in den normalen Ergebnisordner (DXFM_RESULTS)
;; schreiben - ein Testrun soll vollstaendig in tests/output landen.
;; Analog zu TEST_EXPORT_ALL (tests/test_export_all.lsp). WICHTIG:
;; Absichtlich KEIN (setenv "DXFM_RESULTS" ...), siehe dortiger Kommentar.
(if auto-export
(setq *export-test-override* tests-out-dir)
)
(princ "\n")
(princ "\n================================================================")
(princ "\n SSG_RUN_ALL_TESTS")
(princ (strcat "\n " (itoa anz) " Testmodule (aus alltests.json)"))
(princ (if auto-export
"\n Modus: Automatik (speichern + CSV/Sivas-Export + schliessen)"
"\n Modus: Kontrolle (Zeichnungen bleiben offen, kein Export)"
))
(princ "\n================================================================")
;; GUI aus fuer den gesamten Batch: kein Modul (insb. VarioFoerderer-Linienzug)
;; oeffnet DCL-/Wizard-Dialoge, die den automatischen Lauf blockieren wuerden.
;; Am Ende wieder einschalten. Siehe ssg-gui-aus/-an in ssg_core.lsp.
(if (car (atoms-family 1 '("SSG-GUI-AUS"))) (ssg-gui-aus))
;; Rueckfragen des Exports (export.lsp) fuer den ganzen Lauf abschalten -
;; zusaetzlich zur GUI-Sperre, damit auch ein Test, der die GUI wieder
;; einschaltet, den Export nicht anhalten kann.
(setq old-hoehencheck (if (boundp '*csv-hoehencheck-fragen*) *csv-hoehencheck-fragen*)
old-bereinigen (if (boundp '*csv-bereinigen-vor-export*) *csv-bereinigen-vor-export*))
(setq *csv-hoehencheck-fragen* nil
*csv-bereinigen-vor-export* 'aus)
;; Tests laden und ausfuehren
;; Jeder Test bekommt eine eigene neue Zeichnung (statt die aktuelle
;; zu leeren/wiederzuverwenden) und bleibt danach als Tab offen.
(foreach entry *test-module*
(setq idx (1+ idx))
(setq name (cdr (assoc "name" entry)))
(setq save-fmt (cdr (assoc "save" entry)))
(setq module (cdr (assoc "module" entry)))
(if (cdr (assoc "disabled" entry))
;; Test in alltests.json per "disabled": true abgeschaltet - ueberspringen,
;; nichts bauen/speichern/exportieren, nur Hinweis ausgeben.
(princ (strcat "\n\n>>> " (itoa idx) "/" (itoa anz) ": " name
" <<< [DEAKTIVIERT in alltests.json - uebersprungen]"))
(progn
;; Namen aus Konvention ableiten
(setq namen (test-module-names name tests-pfad))
(setq datei (cdr (assoc "datei" namen)))
(setq befehl (cdr (assoc "befehl" namen)))
(setq export-fn (cdr (assoc "export-fn" namen)))
;; Benoetigtes LISP-Modul laden (falls noch nicht geschehen)
(if module
(ssg-ensure module)
)
;; Alte Ergebnis-JSON loeschen: fehlgeschlagene Tests sind am Fehlen der Datei erkennbar
(setq old-json (strcat tests-out-dir "/" name "_results.json"))
(if (findfile old-json)
(vl-file-delete old-json)
)
(princ (strcat "\n\n>>> " (itoa idx) "/" (itoa anz) ": " befehl " <<<"))
(if save-fmt
(princ (strcat " [save: " save-fmt "]"))
(princ " [kein Speichern]")
)
;; Neue, leere Zeichnung fuer diesen Test anlegen und aktivieren
(setq new-doc (vla-add (vla-get-documents app)))
(vla-put-activedocument app new-doc)
;; vf_core.lsp/Gefaellestrecke.lsp setzen die globalen Variablen "doc"
;; und "modelspace" nur EINMAL, beim ersten Laden des Moduls (Top-Level-
;; Code, kein erneuter Aufruf durch ssg-ensure). Ohne diese Aktualisierung
;; wuerden VarioFoerderer/Gefaellestrecke weiterhin in das allererste
;; Dokument der Sitzung zeichnen statt in die hier neu angelegte
;; Zeichnung - die neuen Tabs blieben leer.
(setq doc new-doc)
(setq modelspace (vla-get-modelspace new-doc))
;; Block-Library-Flag zuruecksetzen (Bloecke sind pro Zeichnung neu zu laden)
(setq *lib-initialized* nil)
;; Nummernzaehler zuruecksetzen: der Lauf bleibt im LISP-Namensraum des
;; Startdokuments, die Zaehler (max aus Zeichnung UND Zaehler, +1) liefen
;; sonst ueber alle Tests weiter - VF_5/Kreisel12 statt VF_1/Kreisel1 in
;; einer frischen Zeichnung, die Namen hingen damit von der
;; Testreihenfolge ab und jeder Referenz-Diff wurde unruhig.
(setq #VF_LetzteNr 0 #GF_LetzteNr 0 #Kreisel_LetzteNr 0 #Eckrad_LetzteNr 0)
(testrun:log-start name)
(testrun:log (strcat "Test " (itoa idx) "/" (itoa anz) ": " befehl
" Modul=" (if module module "-")
" save=" (if save-fmt save-fmt "-")
" Modus=" (if auto-export "Automatik" "Kontrolle")))
(testrun:log (strcat "Vor Test: " (testrun:zustand)))
(if (findfile datei)
(progn
(load datei)
;; Test mit Fehlerbehandlung ausfuehren
(testrun:log (strcat "Starte " befehl))
(setq test-result
(vl-catch-all-apply
'(lambda ()
(eval (list (read (strcat "c:" befehl))))
)
nil
)
)
(if (vl-catch-all-error-p test-result)
(progn
(princ (strcat "\n FEHLER in " befehl ": "
(vl-catch-all-error-message test-result)))
(testrun:log (strcat "FEHLER in " befehl ": "
(vl-catch-all-error-message test-result))))
(testrun:log (strcat befehl " beendet")))
(testrun:log (strcat "Nach Test: " (testrun:zustand)))
;; JSON-Export (immer)
(apply export-fn (list tests-out-dir))
(testrun:log (strcat "Ergebnis-JSON " name "_results.json: "
(if (findfile old-json) "vorhanden" "FEHLT")))
(setq out-path (strcat tests-out-dir "/" name "_tests"))
(if auto-export
;; ==========================================================
;; AUTOMATIK-MODUS: speichern (vereinfacht, kein Tab-Naming-
;; Trick noetig) + CSV/Sivas-Export + Zeichnung schliessen.
;; ==========================================================
(progn
(cond
((and save-fmt (= (strcase save-fmt) "DWG"))
(setq dwg-pfad (strcat out-path ".dwg"))
(vla-saveas new-doc dwg-pfad)
(princ (strcat "\n DWG gespeichert: " dwg-pfad))
)
((and save-fmt (= (strcase save-fmt) "DXF"))
;; FILEDIA=0 erzwingen: sonst oeffnet "_.DXFOUT" den nativen
;; Speichern-Dialog (blockiert im Skriptlauf) statt die
;; Kommandozeilen-Prompts (Dateiname/Genauigkeit) zu nutzen -
;; das brachte den nachfolgenden vla-close aus dem Takt
;; (siehe Kontroll-Modus-Zweig weiter unten fuer Details).
(setq old-filedia (getvar "FILEDIA"))
(setvar "FILEDIA" 0)
(command "_.DXFOUT" out-path 6)
(setvar "FILEDIA" old-filedia)
(princ (strcat "\n DXF gespeichert: " out-path ".dxf"))
)
(T
(princ "\n (kein Speichern der Zeichnung)")
)
)
;; CSV/Sivas-Export direkt auf der offenen Zeichnung.
;; *export-filenames* temporaer umbiegen, damit jeder Test
;; seine eigenen CSV-Ergebnisse bekommt (statt der fixen
;; Standardnamen "export.csv"/"export_sivas.csv").
(setq csv-name (strcat name "_tests_export.csv"))
(setq sivas-name (strcat name "_tests_sivas.csv"))
(setq csv-pfad (strcat tests-out-dir "/" csv-name))
(setq sivas-pfad (strcat tests-out-dir "/" sivas-name))
(if (findfile csv-pfad) (vl-file-delete csv-pfad))
(if (findfile sivas-pfad) (vl-file-delete sivas-pfad))
;; Nur die beiden CSV-Namen ersetzen, alle uebrigen Keys
;; (z.B. kreisel_weichen_datei) unveraendert uebernehmen -
;; eine hart nachgebaute Liste verliert sonst neue Keys.
;; Nach vla-saveas (save "dwg") ist die Zeichnung benannt
;; (DWGTITLED=1, DWGNAME=<name>_tests.dwg), und der Export
;; setzt selbst "<name>_tests_" davor (export:dwg-praefix).
;; Diesen Praefix hier abziehen, sonst entsteht
;; "<name>_tests_<name>_tests_export.csv" und das Warten auf
;; csv-pfad laeuft ins Timeout. DXFOUT benennt die Zeichnung
;; nicht um -> Praefix leer, Name bleibt vollstaendig.
(setq praefix (export:dwg-praefix))
(setq old-filenames *export-filenames*)
(setq *export-filenames*
(mapcar
'(lambda (p)
(cond ((= (car p) "sivas_csv")
(cons "sivas_csv" (testrun:ohne-praefix sivas-name praefix)))
((= (car p) "csv_csv")
(cons "csv_csv" (testrun:ohne-praefix csv-name praefix)))
(T p)))
old-filenames))
;; Unmittelbar vor dem Export erneut erzwingen: export.lsp setzt
;; *csv-hoehencheck-fragen* beim (Nach-)Laden von nil auf T, und
;; ein Test kann die GUI wieder eingeschaltet haben.
(if (not (and (boundp '*ssg-gui-aus*) *ssg-gui-aus*))
(progn
(testrun:log "WARNUNG: GUI war nach dem Test wieder AN - fuer den Export abgeschaltet")
(princ "\n WARNUNG: GUI war nach dem Test wieder an - abgeschaltet.")
(ssg-gui-aus)))
(setq *csv-hoehencheck-fragen* nil
*csv-bereinigen-vor-export* 'aus)
(testrun:log (strcat "Vor Export: " (testrun:zustand)))
(princ (strcat "\n CSV-Export -> " csv-name))
(testrun:log (strcat "EXPORTCSV -> " csv-pfad))
(c:EXPORTCSV)
(setq csv-ok (testrun:wait-for-file csv-pfad 30.0))
(princ (if csv-ok "\n CSV OK" "\n CSV TIMEOUT/FEHLER"))
(testrun:log (if csv-ok "EXPORTCSV OK" "EXPORTCSV TIMEOUT/FEHLER - Datei nicht entstanden"))
(princ (strcat "\n Sivas-Export -> " sivas-name))
(testrun:log (strcat "EXPORTSIVAS -> " sivas-pfad))
(c:EXPORTSIVAS)
(setq sivas-ok (testrun:wait-for-file sivas-pfad 30.0))
(princ (if sivas-ok "\n Sivas OK" "\n Sivas TIMEOUT/FEHLER"))
(testrun:log (if sivas-ok "EXPORTSIVAS OK" "EXPORTSIVAS TIMEOUT/FEHLER - Datei nicht entstanden"))
(setq *export-filenames* old-filenames)
;; Zeichnung schliessen: der urspruenglich schon offene Tab
;; bleibt unangetastet, BricsCAD erzeugt daher kein neues
;; Blank-Dokument samt Modul-/Menue-Reload.
(testrun:log "Zeichnung schliessen")
(vla-close new-doc :vlax-false)
(testrun:log "Test fertig")
)
;; ==========================================================
;; KONTROLL-MODUS: speichern, auf Inhalt zoomen, Tab offen
;; lassen (bisheriges Verhalten).
;; ==========================================================
(progn
(cond
((and save-fmt (= (strcase save-fmt) "DWG"))
;; Direkt als DWG speichern - Tab bleibt offen und benannt.
;; Ueber ActiveX statt "_.-SAVEAS" "R2013" ...: Das Versions-
;; Keyword "R2013" wird von BricsCADs Kommandozeilen-SAVEAS
;; nicht zuverlaessig erkannt, wodurch der Befehl auf eine
;; ungueltige Eingabe wartet und nie eine Datei schreibt
;; (nachfolgende LISP-Eingaben landen dann im haengenden
;; Prompt). vla-saveas ist deterministisch.
(setq dwg-pfad (strcat out-path ".dwg"))
(vla-saveas new-doc dwg-pfad)
(princ (strcat "\n DWG gespeichert: " dwg-pfad))
)
((and save-fmt (= (strcase save-fmt) "DXF"))
;; Erst als DWG speichern (nur fuer den Tab-Namen) und DXF
;; exportieren. Danach die Zeichnung schliessen (entsperrt die
;; DWG-Datei), die temporaere DWG loeschen und stattdessen die
;; eigentlich angeforderte DXF-Datei erneut oeffnen - der Tab
;; ist dann korrekt an die DXF gebunden, keine ungewollte DWG
;; bleibt liegen.
(setq dwg-pfad (strcat out-path ".dwg"))
(setq dxf-pfad (strcat out-path ".dxf"))
(vla-saveas new-doc dwg-pfad)
;; FILEDIA=0 erzwingen: sonst oeffnet "_.DXFOUT" den nativen
;; Speichern-Dialog statt der Kommandozeilen-Prompts - der
;; Skriptlauf haengt dann in einem offenen Dialog fest, und
;; der nachfolgende vla-close (auf dem noch "belegten"
;; Dokument) bricht mit "bad argument type <0>" ab, weil
;; new-doc dabei ungueltig wird.
(setq old-filedia (getvar "FILEDIA"))
(setvar "FILEDIA" 0)
(command "_.DXFOUT" out-path 6)
(setvar "FILEDIA" old-filedia)
(vla-close new-doc :vlax-false)
(if (findfile dwg-pfad) (vl-file-delete dwg-pfad))
(setq new-doc (vla-open (vla-get-documents app) dxf-pfad))
(vla-put-activedocument app new-doc)
(setq doc new-doc)
(setq modelspace (vla-get-modelspace new-doc))
(princ (strcat "\n DXF gespeichert: " dxf-pfad))
)
(T
;; Kein Speichern angefordert: keine Datei erzeugen, Tab
;; bleibt beim generischen Namen ("ZeichnungN").
(princ "\n (kein Speichern der Zeichnung)")
)
)
;; Ansicht auf den gesamten Inhalt zoomen, Tab bleibt offen
;; (naechster Test startet in einer neuen Zeichnung).
(command "_.ZOOM" "_Extents")
)
)
)
(progn
(princ (strcat "\n WARNUNG: " datei " nicht gefunden - uebersprungen"))
(testrun:log (strcat "WARNUNG: " datei " nicht gefunden - uebersprungen")))
)
) ;; end (progn ...) des aktiven Zweigs
) ;; end (if (cdr (assoc "disabled" entry)) ...)
)
;; GUI wieder einschalten (Batch fertig).
(if (car (atoms-family 1 '("SSG-GUI-AN"))) (ssg-gui-an))
;; nil = "nie gesetzt" (export.lsp belegt dann mit der Vorgabe vor)
(setq *csv-hoehencheck-fragen* (if old-hoehencheck old-hoehencheck T)
*csv-bereinigen-vor-export* (if old-bereinigen old-bereinigen 'an))
(setq *testrun-log* nil)
(setq *export-test-override* nil)
(princ "\n\n================================================================")
(princ "\n SSG_RUN_ALL_TESTS abgeschlossen.")
(princ (strcat "\n Ergebnisse in: " (getenv "DXFMAKRO") "/tests/output/"))
(if (not auto-export)
(princ "\n CSV/Sivas-Export: TEST_EXPORT_ALL manuell aufrufen (Menue: Tests -> Export CSV/Sivas ALL)")
)
(princ "\n================================================================")
(princ)
)
;; Menue-Wrapper: fester Modus ohne Rueckfrage.
;; _EXPORT = Automatik (speichern + CSV/Sivas-Export + schliessen)
;; _OFFEN = Kontrolle (Zeichnungen bleiben offen, kein Export)
(defun c:SSG_RUN_ALL_TESTS_EXPORT ()
(setq *ssg-run-all-auto-export* T)
(c:SSG_RUN_ALL_TESTS)
)
(defun c:SSG_RUN_ALL_TESTS_OFFEN ()
(setq *ssg-run-all-auto-export* nil)
(c:SSG_RUN_ALL_TESTS)
)
Reference in New Issue View Git Blame Copy Permalink