diff --git a/Lisp/check_hoehen.lsp b/Lisp/check_hoehen.lsp index 51c5ae6..24ad92c 100644 --- a/Lisp/check_hoehen.lsp +++ b/Lisp/check_hoehen.lsp @@ -16,10 +16,12 @@ ;;; - ENTER -> Markierungskreis (Layer *ch-mark-layer*), ;;; Block spaeter manuell anpassen. ;;; -;;; Phase 3 - Buehne: liegt die rohe Montagehoehe ueber -;;; *ch-buehne-schwelle-m* (Default 2,0 m), wird pro Block gefragt, -;;; ob eine Buehne vorhanden ist; deren Hoehe wird abgezogen -;;; (MONTAGEHOEHE_m = roh - Buehne). +;;; Phase 3 - Buehne nach Kreisel-Familien (siehe Abschnitt PHASE 3): +;;; liegt eine Familie ueber *ch-buehne-schwelle-m* (Default 3,0 m), wird +;;; EINMAL pro Familie gefragt; die Buehnenhoehe wird von den Kreiseln und +;;; den zugehoerigen VF/GF abgezogen (MONTAGEHOEHE_m = roh - Buehne). +;;; Bloecke, die keiner Familie zuzuordnen sind, werden wie frueher +;;; einzeln gefragt (ch-write-montage). ;;; ;;; PHASE 1-3 bewusst OHNE: QSAVE (Testmodus, UNDO moeglich). ;;; @@ -42,7 +44,19 @@ ;; Schwelle (m): ab dieser Montagehoehe wird pro Block nach einer ;; Buehne gefragt (typische Anlagenhoehe ~2 m; darueber liegt die ;; Anlage vermutlich auf einer Buehne). -(if (null *ch-buehne-schwelle-m*) (setq *ch-buehne-schwelle-m* 2.0)) +(if (null *ch-buehne-schwelle-m*) (setq *ch-buehne-schwelle-m* 3.0)) + +;; Phase 3 (Familien): maximaler Hoehenunterschied zweier Kreisel-Familien (mm), +;; zwischen denen eine Strecke denselben Buehnenabzug bekommt, und +;; Zuordnungstoleranzen Strecken-Ende -> Kreisel (XY-Abstand zur Kreiselachse +;; ueber den Radradius hinaus, Hoehenabweichung in mm). +(if (null *ch-fam-max-hoehendiff-mm*) (setq *ch-fam-max-hoehendiff-mm* 1500.0)) +(if (null *ch-zuordnung-xy-mm*) (setq *ch-zuordnung-xy-mm* 300.0)) +(if (null *ch-zuordnung-z-mm*) (setq *ch-zuordnung-z-mm* 100.0)) + +;; Register der in Phase 1/2 geschriebenen Bloecke fuer Phase 3: +;; je Block (ent art lbl roh pein paus erledigt). +(setq *ch-rec* nil) ;;; ------------------------------------------------------------ ;;; vf_core-KS-Helfer sicherstellen (extract-ks-from-block-raw). @@ -127,12 +141,19 @@ (if entry (caddr (car entry)) nil) ) +;;; Ganzer KS-Ursprung (x y z) oder nil. +(defun ch-ks-pt (ksdata ksname / entry) + (setq entry (cadr (assoc ksname ksdata))) + (if entry (car entry) nil) +) + ;;; ------------------------------------------------------------ ;;; KS_EIN.Z / KS_AUS.Z eines Composite-Blocks (VF_n/GF_n) messen. -;;; Rueckgabe: (kez kaz) - fehlende Werte = nil. +;;; Rueckgabe: (kez kaz pein paus) - fehlende Werte = nil. pein/paus sind +;;; die ganzen KS-Ursprungspunkte (fuer die Kreisel-Zuordnung in Phase 3). ;;; ------------------------------------------------------------ -(defun ch-measure-vfgf (ename / obj subs nm ksdata kez kaz) - (setq kez nil kaz nil) +(defun ch-measure-vfgf (ename / obj subs nm ksdata kez kaz pein paus) + (setq kez nil kaz nil pein nil paus nil) (setq obj (vlax-ename->vla-object ename)) (setq subs (vl-catch-all-apply 'vlax-invoke (list obj 'Explode))) (if (and (not (vl-catch-all-error-p subs)) subs) @@ -145,10 +166,12 @@ (cond ((and (null kez) (wcmatch nm *ch-as-pattern*)) (setq ksdata (extract-ks-from-block-raw sub)) - (setq kez (ch-ks-z ksdata "KS_EIN"))) + (setq kez (ch-ks-z ksdata "KS_EIN") + pein (ch-ks-pt ksdata "KS_EIN"))) ((and (null kaz) (wcmatch nm *ch-es-pattern*)) (setq ksdata (extract-ks-from-block-raw sub)) - (setq kaz (ch-ks-z ksdata "KS_AUS"))) + (setq kaz (ch-ks-z ksdata "KS_AUS") + paus (ch-ks-pt ksdata "KS_AUS"))) ) ) ) @@ -158,7 +181,7 @@ (vl-catch-all-apply 'vla-Delete (list sub)))) ) ) - (list kez kaz) + (list kez kaz pein paus) ) ;;; ------------------------------------------------------------ @@ -278,7 +301,264 @@ ) ;;; ============================================================ -;;; HAUPTBEFEHL (Phase 1 + 2) +;;; PHASE 3 - Buehnen-Familien +;;; ------------------------------------------------------------ +;;; Kreisel, die sich beruehren (Rad/Rad, Rad/Laufprofil, gleiche Hoehe - +;;; KREISEL_WEICHEN-Kern kreisel-bp-*), haben zwingend dieselbe Hoehe und +;;; bilden eine FAMILIE. Pro Familie ueber der Schwelle wird EINMAL nach +;;; der Buehne gefragt; deren Hoehe wird von den Kreiseln der Familie und +;;; von allen VF/GF abgezogen, deren beide Enden in dieser Familie liegen. +;;; Strecken zwischen zwei Familien bekommen den Abzug nur bei gleicher +;;; Buehnenhoehe UND hoechstens *ch-fam-max-hoehendiff-mm* Hoehenunterschied. +;;; Geschrieben wird nur MONTAGEHOEHE_m (aus der Rohhoehe, also wiederholbar); +;;; HOEHE/HOEHE_VON_mm bleiben, damit csv:hoehen-aktualisieren nichts zurueck- +;;; setzt. +;;; ============================================================ + +;;; Wurzel eines Knotens in der Eltern-Alist (Union-Find ohne Pfadkompression). +(defun ch-fam-wurzel (rep k / p) + (while (and (setq p (cdr (assoc k rep))) (/= p k)) + (setq k p)) + k +) + +;;; Familien aus Knoten und Kanten (reiner Kern). +;;; knoten = ((schluessel idnum) ...), kanten = ((schluesselA schluesselB) ...) +;;; Rueckgabe: Liste von Familien (je Liste von Schluesseln). Mitglieder und +;;; Familien sind nach kleinster ID-Nummer geordnet (Gleichstand: Reihenfolge +;;; in knoten); unbekannte Schluessel in kanten werden uebergangen. +(defun ch-familien (knoten kanten / rep ra rb idx sortiert fams w) + (foreach k knoten (setq rep (cons (cons (car k) (car k)) rep))) + (foreach e kanten + (if (and (assoc (car e) rep) (assoc (cadr e) rep)) + (progn + (setq ra (ch-fam-wurzel rep (car e)) + rb (ch-fam-wurzel rep (cadr e))) + (if (/= ra rb) + (setq rep (subst (cons ra rb) (assoc ra rep) rep)))))) + (setq idx 0) + (foreach k knoten + (setq sortiert (cons (list (cadr k) (car k) idx) sortiert) + idx (1+ idx))) + (setq sortiert (vl-sort sortiert 'ch-id<)) + (foreach s sortiert + (setq w (ch-fam-wurzel rep (cadr s))) + (if (assoc w fams) + (setq fams (subst (append (assoc w fams) (list (cadr s))) (assoc w fams) fams)) + (setq fams (append fams (list (list w (cadr s))))))) + (mapcar 'cdr fams) +) + +;;; Abzugsregel fuer eine Strecke zwischen zwei VERSCHIEDENEN Familien +;;; (reiner Kern). b1/b2 = Buehnenhoehe der Familien in m (0 = keine), +;;; z1/z2 = Familienhoehen in mm, maxdiff = erlaubter Unterschied in mm. +;;; Rueckgabe (status . abzug_m): "kein" (beide ohne Buehne), "konflikt" +;;; (verschiedene Buehnenhoehen), "hoehe" (Familien zu weit auseinander), +;;; "abzug" (gleiche Buehne, abzug_m = b1). +(defun ch-kreuz-abzug (b1 b2 z1 z2 maxdiff) + (cond + ((and (equal b1 0.0 1e-6) (equal b2 0.0 1e-6)) (cons "kein" 0.0)) + ((not (equal b1 b2 1e-6)) (cons "konflikt" 0.0)) + ((> (abs (- z1 z2)) maxdiff) (cons "hoehe" 0.0)) + (t (cons "abzug" b1)) + ) +) + +;;; Montagehoehe nach Buehnenabzug (reiner Kern). nil, wenn kein gueltiger +;;; Abzug moeglich ist (b <= 0 oder b >= roh). +(defun ch-abzug-anwenden (roh b) + (if (and (> b 0.0) (< b roh)) (- roh b)) +) + +;;; XY-Abstand eines Punktes von der Strecke a-b (reiner Kern). +(defun ch-pkt-strecke-abstand (pt a b / lot tt) + (setq lot (kreisel-bp-lot pt a b) + tt (max 0.0 (min 1.0 (car lot)))) + (kreisel-bp-abst pt (kreisel-bp-plus a (kreisel-bp-mal (kreisel-bp-minus b a) tt))) +) + +;;; Naechster Kreisel/Eckrad zu einem Strecken-Endpunkt (reiner Kern). +;;; pt = (x y [z]), z = Hoehe in mm, elemente = kreisel-bp-element-Records. +;;; Treffer: XY-Abstand zur Achse <= Radradius + tolxy und |z - Kreiselhoehe| +;;; <= tolz. Rueckgabe: Handle des naechsten Treffers oder nil. +(defun ch-kreisel-finden (pt z elemente tolxy tolz / best bd d ac) + (foreach e elemente + (if (<= (abs (- z (kreisel-bp-get "z" e))) tolz) + (progn + (setq ac (kreisel-bp-get "achse" e) + d (ch-pkt-strecke-abstand pt (car ac) (cadr ac))) + (if (and (<= d (+ (kreisel-bp-get "r" e) tolxy)) + (or (null bd) (< d bd))) + (setq bd d best (kreisel-bp-get "handle" e)))))) + best +) + +;;; Abzugsregel fuer eine Strecke aus den Familiensaetzen ihrer beiden Enden +;;; (reiner Kern). fs/fe = (idx handles z b). Gleiche Familie -> ("innen" . b), +;;; sonst Ergebnis von ch-kreuz-abzug. +(defun ch-strecke-abzug (fs fe maxdiff) + (if (= (car fs) (car fe)) + (cons "innen" (cadddr fs)) + (ch-kreuz-abzug (cadddr fs) (cadddr fe) (caddr fs) (caddr fe) maxdiff)) +) +;;; ID-Nummer eines Elements (999999 ohne gueltige ID). +(defun ch-id-nummer (id) + (if (and id (/= id "") (> (atoi id) 0)) (atoi id) 999999) +) + +;;; Element-Record zu einem Handle. +(defun ch-elem-zu-handle (h elemente / res) + (foreach e elemente + (if (and (null res) (= (kreisel-bp-get "handle" e) h)) (setq res e))) + res +) + +;;; Kreisel-Modul (kreisel-bp-*) sicherstellen. +(defun ch-ensure-kreisel () + (if (null (car (atoms-family 1 '("KREISEL-BP-BERECHNEN")))) + (if (car (atoms-family 1 '("SSG-ENSURE"))) + (vl-catch-all-apply '(lambda () (ssg-ensure "KreiselInsert"))))) + (if (car (atoms-family 1 '("KREISEL-BP-BERECHNEN"))) t nil) +) + +;;; Montage-Rohwert schreiben (ohne Rueckfrage) und fuer Phase 3 vormerken. +;;; pts = (pein paus) bei VF/GF, sonst nil. Rueckgabe: roh. +(defun ch-montage-roh (ent art raw lbl pts) + (ch-set-att ent "MONTAGEHOEHE_m" (rtos raw 2 3)) + (setq *ch-rec* (append *ch-rec* + (list (list ent art lbl raw (car pts) (cadr pts))))) + raw +) + +;;; Familie hervorheben (mode 3) bzw. zuruecknehmen (mode 4). +(defun ch-fam-hervorheben (handles mode / e) + (foreach h handles + (if (setq e (handent h)) (redraw e mode))) +) + +;;; Buehnenhoehe (m) fuer eine Familie erfragen. nil = keine Buehne. +;;; z = Familienhoehe in mm, prev = zuletzt eingegebene Buehne (Vorgabe) oder nil. +(defun ch-frage-buehne (txt z prev / b ok) + (if (ssg-in-yesno txt nil) + (progn + (while (not ok) + (setq b (ssg-in-real (ssg-text "chh-buehne-hoehe") prev)) + (cond + ((null b) (setq ok T)) + ((and (> b 0.0) (< b (/ z 1000.0))) (setq ok T)) + (t (princ (ssg-textf "chh-buehne-ungueltig" (list (rtos (/ z 1000.0) 2 3)))) + (setq b nil)))) + b)) +) + +;;; Phase 3 ausfuehren: arbeitet das Register *ch-rec* ab. Bloecke ohne +;;; Familie (Zuordnung unklar) fragen wie zuvor einzeln nach. +(defun ch-phase3 ( / elems ber knoten kanten fams famdat h2f n-fam n-bue + rep z b prev rec idx fs fe kr neu lbl h + n-kr n-innen n-kreuz n-konf n-offen ents) + (setq n-kr 0 n-innen 0 n-kreuz 0 n-konf 0 n-offen 0 n-fam 0 n-bue 0 + ents nil) + (princ (ssg-text "chh-start")) + (if (ch-ensure-kreisel) + (progn + (setq elems (kreisel-bp-elemente-sammeln) + ber (car (kreisel-bp-berechnen elems (kreisel-bp-toleranz) + (kreisel-bp-toleranz-z)))) + (setq knoten (mapcar '(lambda (el) (list (kreisel-bp-get "handle" el) + (ch-id-nummer (kreisel-bp-get "id" el)))) + elems) + kanten (mapcar '(lambda (tr) (list (kreisel-bp-get "handle" (kreisel-bp-get "a" tr)) + (kreisel-bp-get "handle" (kreisel-bp-get "b" tr)))) + ber)) + (setq fams (ch-familien knoten kanten)) + + ;; --- je Familie einmal fragen --- + (setq idx 0) + (foreach fam fams + (setq idx (1+ idx) n-fam (1+ n-fam) + rep (ch-elem-zu-handle (car fam) elems) + z (kreisel-bp-get "z" rep) + b 0.0) + (if (> (/ z 1000.0) *ch-buehne-schwelle-m*) + (progn + (ch-fam-hervorheben fam 3) + (setq b (ch-frage-buehne + (ssg-textf "chh-fam-frage" + (list (itoa idx) (kreisel-bp-elem-text rep) + (itoa (length fam)) (rtos (/ z 1000.0) 2 3))) + z prev)) + (ch-fam-hervorheben fam 4) + (if (null b) (setq b 0.0)) + (if (> b 0.0) (setq prev b n-bue (1+ n-bue))))) + (setq famdat (cons (list idx fam z b) famdat)) + (foreach h fam (setq h2f (cons (cons h idx) h2f)))) + (setq famdat (reverse famdat)) + + ;; --- Kreisel schreiben --- + (foreach rec *ch-rec* + (if (= (cadr rec) "KREISEL") + (progn + (setq h (cdr (assoc 5 (entget (car rec)))) + fs (cdr (assoc h h2f))) + (if fs + (progn + (setq b (cadddr (assoc fs famdat))) + (if (> b 0.0) + (if (setq neu (ch-abzug-anwenden (nth 3 rec) b)) + (progn (ch-set-att (car rec) "MONTAGEHOEHE_m" (rtos neu 2 3)) + (setq n-kr (1+ n-kr))))) + (setq ents (cons (car rec) ents))))))) + + ;; --- Strecken zuordnen --- + (foreach rec *ch-rec* + (if (and (member (cadr rec) '("VF" "GF")) (nth 4 rec) (nth 5 rec)) + (progn + (setq lbl (nth 2 rec) + fs (ch-kreisel-finden (nth 4 rec) (caddr (nth 4 rec)) elems + *ch-zuordnung-xy-mm* *ch-zuordnung-z-mm*) + fe (ch-kreisel-finden (nth 5 rec) (caddr (nth 5 rec)) elems + *ch-zuordnung-xy-mm* *ch-zuordnung-z-mm*)) + (if (and fs fe) + (progn + (setq fs (assoc (cdr (assoc fs h2f)) famdat) + fe (assoc (cdr (assoc fe h2f)) famdat) + kr (ch-strecke-abzug fs fe *ch-fam-max-hoehendiff-mm*)) + (setq ents (cons (car rec) ents)) + (cond + ((= (car kr) "konflikt") + (setq n-konf (1+ n-konf)) + (princ (ssg-textf "chh-kreuz-konflikt" + (list lbl (rtos (cadddr fs) 2 3) (rtos (cadddr fe) 2 3))))) + ((= (car kr) "hoehe") + (setq n-konf (1+ n-konf)) + (princ (ssg-textf "chh-kreuz-hoehe" + (list lbl (rtos (abs (- (caddr fs) (caddr fe))) 2 0) + (rtos *ch-fam-max-hoehendiff-mm* 2 0))))) + ((> (cdr kr) 0.0) + (if (setq neu (ch-abzug-anwenden (nth 3 rec) (cdr kr))) + (progn + (ch-set-att (car rec) "MONTAGEHOEHE_m" (rtos neu 2 3)) + (if (= (car kr) "innen") + (setq n-innen (1+ n-innen)) + (setq n-kreuz (1+ n-kreuz)))) + (princ (ssg-textf "chh-strecke-neg" + (list lbl (rtos (cdr kr) 2 3) (rtos (nth 3 rec) 2 3)))))) + ))))))) + (princ (ssg-text "chh-kein-kreisel"))) + + ;; --- Rest: blockweise wie bisher --- + (foreach rec *ch-rec* + (if (not (member (car rec) ents)) + (progn + (setq n-offen (1+ n-offen)) + (ch-write-montage (car rec) (nth 3 rec) (nth 2 rec))))) + (princ (ssg-textf "chh-summe" + (list (itoa n-fam) (itoa n-bue) (itoa n-kr) (itoa n-innen) + (itoa n-kreuz) (itoa n-konf) (itoa n-offen)))) +) + +;;; ============================================================ +;;; HAUPTBEFEHL (Phase 1 + 2, danach Phase 3) ;;; ============================================================ (defun c:HOEHEN_CHECK ( / ss i idx id items it ent ed nm lbl zc meas kez kaz montage inp delta mss @@ -292,6 +572,7 @@ ) ) (setq n-kreisel 0 n-vf 0 n-gf 0 n-fixed 0 n-marked 0 n-fehler 0) + (setq *ch-rec* nil) ;; Alte Markierungskreise entfernen (Idempotenz) (setq mss (ssget "_X" (list (cons 0 "CIRCLE") (cons 8 *ch-mark-layer*)))) @@ -348,7 +629,7 @@ (ch-move-z ent (- inp zc)) (setq zc inp) (ch-set-att ent "HOEHE" (rtos zc 2 0)) - (setq montage (ch-write-montage ent (/ zc 1000.0) lbl)) + (setq montage (ch-montage-roh ent "KREISEL" (/ zc 1000.0) lbl nil)) (setq n-fixed (1+ n-fixed)) (princ (strcat "\n -> verschoben & gesetzt: HOEHE=" (rtos zc 2 0) " -> MONTAGEHOEHE_m=" (rtos montage 2 3)))) @@ -362,7 +643,7 @@ ;; --- gueltig --- (progn (ch-set-att ent "HOEHE" (rtos zc 2 0)) - (setq montage (ch-write-montage ent (/ zc 1000.0) lbl)) + (setq montage (ch-montage-roh ent "KREISEL" (/ zc 1000.0) lbl nil)) (princ (strcat "\n " lbl ": HOEHE=" (rtos zc 2 0) " -> MONTAGEHOEHE_m=" (rtos montage 2 3)))) ) @@ -399,10 +680,11 @@ (progn (ch-set-att ent "HOEHE_VON_mm" (rtos kez 2 0)) (ch-set-att ent "HOEHE_BIS_mm" (rtos kaz 2 0)) - (setq montage (ch-write-montage ent + (setq montage (ch-montage-roh ent + (if (wcmatch nm "GF_*") "GF" "VF") (if (wcmatch nm "GF_*") (/ kez 1000.0) - (/ (+ kez kaz) 2000.0)) lbl)) + (/ (+ kez kaz) 2000.0)) lbl (cddr meas))) (setq n-fixed (1+ n-fixed)) (princ (strcat "\n -> verschoben & gesetzt: VON=" (rtos kez 2 0) ", BIS=" (rtos kaz 2 0) @@ -420,10 +702,11 @@ (t (ch-set-att ent "HOEHE_VON_mm" (rtos kez 2 0)) (ch-set-att ent "HOEHE_BIS_mm" (rtos kaz 2 0)) - (setq montage (ch-write-montage ent + (setq montage (ch-montage-roh ent + (if (wcmatch nm "GF_*") "GF" "VF") (if (wcmatch nm "GF_*") (/ kez 1000.0) - (/ (+ kez kaz) 2000.0)) lbl)) + (/ (+ kez kaz) 2000.0)) lbl (cddr meas))) (princ (strcat "\n " lbl ": HOEHE_VON_mm=" (rtos kez 2 0) ", HOEHE_BIS_mm=" (rtos kaz 2 0) " -> MONTAGEHOEHE_m=" (rtos montage 2 3)))) @@ -431,6 +714,8 @@ ) ) ) + ;; Phase 3: Buehnen-Familien (arbeitet das Register *ch-rec* ab) + (ch-phase3) (princ (strcat "\n--------------------------------------------" "\n Kreisel: " (itoa n-kreisel) " VF: " (itoa n-vf) @@ -449,4 +734,4 @@ ) (princ "\n>>> check_hoehen.lsp geladen (Phase 1-3). Befehl: HOEHEN_CHECK") -(princ) +(princ) \ No newline at end of file diff --git a/Lisp/export.lsp b/Lisp/export.lsp index cfb93a7..eb52a69 100644 --- a/Lisp/export.lsp +++ b/Lisp/export.lsp @@ -2921,8 +2921,29 @@ ) +;; Vor dem Sivas-Export anbieten, den Hoehen-Check (HOEHEN_CHECK, check_hoehen.lsp) +;; auszufuehren: Er setzt die Montagehoehen inkl. Buehnenabzug, den der Export +;; selbst nicht kennt. Bewusst eine Rueckfrage (Vorgabe Ja, Enter startet den +;; Check, "Nein" ueberspringt ihn) statt automatisch: der Check stellt Fragen +;; und wuerde Hand-Korrekturen von MONTAGEHOEHE_m bei jedem Export ueberschreiben. Entfaellt ohne GUI und bei abgeschaltetem +;; Schalter *csv-hoehencheck-fragen* (automatische Tests). +(if (null *csv-hoehencheck-fragen*) (setq *csv-hoehencheck-fragen* T)) + +(defun csv:hoehencheck-anbieten () + (if (and *csv-hoehencheck-fragen* + (ssg-gui-p) + (car (atoms-family 1 '("SSG-IN-YESNO"))) + (ssg-in-yesno (ssg-text "exp-hoehencheck-frage") T)) + (progn + (ssg-ensure "check_hoehen") + (if (car (atoms-family 1 '("C:HOEHEN_CHECK"))) + (c:HOEHEN_CHECK) + (princ (ssg-text "exp-hoehencheck-fehlt"))))) +) + ;; --- EXPORTSIVAS: Sivas-spezifischer CSV-Export mit Summierungszeilen --- (defun c:EXPORTSIVAS () + (csv:hoehencheck-anbieten) (csv:run-export "EXPORTSIVAS" (export:filename "sivas_script") (export:filename "sivas_csv") diff --git a/doc/kommandos.md b/doc/kommandos.md index d4ab2fb..79ab06d 100644 --- a/doc/kommandos.md +++ b/doc/kommandos.md @@ -145,7 +145,7 @@ Gross-/Kleinschreibung spielt an der Kommandozeile keine Rolle. | `IDSCHECK` | Alle Bloecke auf doppelte IDs pruefen und korrigieren | | `IDGENERATE` | Gewaehltem Block eine neue ID zuweisen | | `ZAEHLE_SEP_SCAN` | Scanner/Separatoren je Kreisel/VF/GF zaehlen und in ANZAHL_SCANNER/ANZAHL_SEPARATOR schreiben (laeuft auch automatisch vor jedem Export) | -| `HOEHEN_CHECK` | Hoehen von Kreiseln/VF/GF messen und in HOEHE/HOEHE_VON_mm/HOEHE_BIS_mm/MONTAGEHOEHE_m schreiben | +| `HOEHEN_CHECK` | Hoehen von Kreiseln/VF/GF messen und in HOEHE/HOEHE_VON_mm/HOEHE_BIS_mm/MONTAGEHOEHE_m schreiben; Phase 3: Buehnenabzug einmal pro Kreisel-Familie (beruehrende Kreisel gleicher Hoehe), wirkt auf Kreisel und die VF/GF der Familie | | `CALLPYTHON` (`external_call.lsp`) | Test des LISP->Python-Aufrufs (`lib/testpycall.py`) | ### Konfiguration, Planquadrate, Doppelklick diff --git a/lang/de_DE.json b/lang/de_DE.json index 08577d3..4ad2cc0 100644 --- a/lang/de_DE.json +++ b/lang/de_DE.json @@ -722,6 +722,8 @@ "plq-geloescht": "\n[DELETE_PLANQUADRATE] Planquadrat-Raster entfernt (%1 Einfuegung(en)).", "plq-nichts-zu-loeschen": "\n[DELETE_PLANQUADRATE] Kein Planquadrat-Raster in der Zeichnung vorhanden.", "exp-check-ids": "\n[%1] Pruefe und vergebe IDs...", + "exp-hoehencheck-frage": "\nVor dem Export den Hoehen-Check (Montagehoehe/Buehnen) ausfuehren?", + "exp-hoehencheck-fehlt": "\nHinweis: HOEHEN_CHECK nicht verfuegbar - Export laeuft ohne Hoehen-Check.", "exp-hoehen-aktualisiert": "\nHoehen-Attribute von %1 verschobenen Bloecken aus der Z-Koordinate neu gesetzt.", "exp-sep-proxy-fehler": "\n[EXPORT] WARNUNG: Kopie von '%1' aus Block '%2' fehlgeschlagen (%3) - dieses Element fehlt im Export.", "exp-sep-zuordnung": "\n[%1] verpackte Separator-Kopie(n): ZUORDNUNG aus der ID des Wrapper-Blocks gesetzt.", @@ -1167,6 +1169,15 @@ "kreisel-bp-zeile": "\n Weiche %1: %2 <-> %3 [%4] bei X=%5 Y=%6 Z=%7", "kreisel-bp-kollision": "\n KOLLISION %1: %2 <-> %3 [%4] bei X=%5 Y=%6 Z=%7", "kreisel-bp-marker": "\n%1 Marker gezeichnet (Layer %2).", + "chh-start": "\n--- Phase 3: Buehnen-Familien ---", + "chh-kein-kreisel": "\n Hinweis: Kreisel-Modul nicht verfuegbar - nur blockweise Abfrage.", + "chh-fam-frage": "\n Familie %1 (%2, %3 Kreisel, Montagehoehe %4 m): liegt auf einer Buehne?", + "chh-buehne-hoehe": "Buehnenhoehe in m", + "chh-buehne-ungueltig": "\n ! Buehnenhoehe muss > 0 und < %1 m sein.", + "chh-kreuz-konflikt": "\n ! %1: Enden in Familien mit verschiedener Buehnenhoehe (%2 / %3 m) - nicht geaendert.", + "chh-kreuz-hoehe": "\n ! %1: Familienhoehen unterscheiden sich um %2 mm (> %3 mm) - nicht geaendert.", + "chh-strecke-neg": "\n ! %1: Buehne %2 m >= Montagehoehe %3 m - nicht geaendert.", + "chh-summe": "\n Phase 3: %1 Familie(n), %2 mit Buehne; angepasst: Kreisel %3, Strecken innerhalb %4, zwischen Familien %5; Konflikte %6; einzeln gefragt %7", "exp-kreisel-weichen": "\n[%1] Kreisel-Weichenpunkte: %2 Beruehrung(en), %3 Kollision(en) -> %4", "exp-kreisel-kollision": "\n[%1] WARNUNG: %2 Kreisel-Kollision(en) - Befehl KREISEL_WEICHEN zeigt sie an.", "kf-fehler-daten-fehlt": "\nFEHLER: Kettenfoerderer-Daten nicht gefunden: %1", diff --git a/lang/en_GB.json b/lang/en_GB.json index 3c58bf7..28e6f3a 100644 --- a/lang/en_GB.json +++ b/lang/en_GB.json @@ -722,6 +722,8 @@ "plq-geloescht": "\n[DELETE_PLANQUADRATE] Planquadrat grid removed (%1 insertion(s)).", "plq-nichts-zu-loeschen": "\n[DELETE_PLANQUADRATE] No Planquadrat grid found in the drawing.", "exp-check-ids": "\n[%1] Checking and assigning IDs...", + "exp-hoehencheck-frage": "\nRun the height check (mounting height/platforms) before the export?", + "exp-hoehencheck-fehlt": "\nNote: HOEHEN_CHECK not available - export runs without height check.", "exp-hoehen-aktualisiert": "\nHeight attributes of %1 moved blocks reset from their Z coordinate.", "exp-sep-proxy-fehler": "\n[EXPORT] WARNING: copying '%1' out of block '%2' failed (%3) - this element is missing from the export.", "exp-sep-zuordnung": "\n[%1] packed separator copy/copies: ZUORDNUNG set from the wrapper block ID.", @@ -1167,6 +1169,15 @@ "kreisel-bp-zeile": "\n Switch %1: %2 <-> %3 [%4] at X=%5 Y=%6 Z=%7", "kreisel-bp-kollision": "\n COLLISION %1: %2 <-> %3 [%4] at X=%5 Y=%6 Z=%7", "kreisel-bp-marker": "\n%1 markers drawn (layer %2).", + "chh-start": "\n--- Phase 3: platform families ---", + "chh-kein-kreisel": "\n Note: Kreisel module not available - per-block questions only.", + "chh-fam-frage": "\n Family %1 (%2, %3 Kreisel, mounting height %4 m): is it on a platform?", + "chh-buehne-hoehe": "Platform height in m", + "chh-buehne-ungueltig": "\n ! Platform height must be > 0 and < %1 m.", + "chh-kreuz-konflikt": "\n ! %1: ends in families with different platform heights (%2 / %3 m) - unchanged.", + "chh-kreuz-hoehe": "\n ! %1: family heights differ by %2 mm (> %3 mm) - unchanged.", + "chh-strecke-neg": "\n ! %1: platform %2 m >= mounting height %3 m - unchanged.", + "chh-summe": "\n Phase 3: %1 family(ies), %2 on a platform; adjusted: Kreisel %3, sections within family %4, between families %5; conflicts %6; asked individually %7", "exp-kreisel-weichen": "\n[%1] Kreisel switch points: %2 contact(s), %3 collision(s) -> %4", "exp-kreisel-kollision": "\n[%1] WARNING: %2 Kreisel collision(s) - command KREISEL_WEICHEN shows them.", "kf-fehler-daten-fehlt": "\nERROR: chain conveyor data not found: %1", diff --git a/menu/SSG_LIB.mnl b/menu/SSG_LIB.mnl index 408f553..7844609 100644 --- a/menu/SSG_LIB.mnl +++ b/menu/SSG_LIB.mnl @@ -156,6 +156,10 @@ (ssg-ensure "VarioFoerderer") (ssg-ensure "EtageVarioFoerderer") (ssg-ensure "export") + ;; Hoehen-Check vorladen: EXPORTSIVAS bietet ihn per Rueckfrage an und ruft + ;; c:HOEHEN_CHECK im selben Lauf auf (ein Nachladen waere dort erst nach + ;; Rueckkehr zum Top-Level sichtbar). + (ssg-ensure "check_hoehen") (ssg-ensure "external_call") (ssg-ensure "OmniModulInsert") ;; Kettenfoerderer vorladen statt lazy: der erste Menueklick musste sonst diff --git a/menu/SSG_LIB.mnu b/menu/SSG_LIB.mnu index dd5ba6d..7bf1be4 100644 --- a/menu/SSG_LIB.mnu +++ b/menu/SSG_LIB.mnu @@ -150,6 +150,7 @@ [Ausgang]^C^C(ssg-ensure "SSG_LIB_Commands") ILS_AUSGANG_INSERT [<-SPS Schliessen]^C^C [->Export] +[Hoehen-Check (Montagehoehe/Buehne)]^C^C(ssg-ensure "check_hoehen") HOEHEN_CHECK [Export Sivas]^C^C(ssg-ensure "export") EXPORTSIVAS [<-Export CSV]^C^C(ssg-ensure "export") EXPORTCSV [->Konfiguration] diff --git a/tests/test_export_all.lsp b/tests/test_export_all.lsp index f91e62b..821818e 100644 --- a/tests/test_export_all.lsp +++ b/tests/test_export_all.lsp @@ -183,6 +183,7 @@ (if (findfile csv-pfad) (vl-file-delete csv-pfad)) (if (findfile sivas-pfad) (vl-file-delete sivas-pfad)) + (setq *csv-hoehencheck-fragen* nil) ;; keine Rueckfrage im Testlauf (princ (strcat "\n[TEST_EXPORT_ALL] CSV-Export -> " csv-name)) (c:EXPORTCSV) (setq csv-ok (export_all:wait-for-file csv-pfad 30.0)) diff --git a/tests/test_unit.lsp b/tests/test_unit.lsp index e2c5ab1..6cb1082 100644 --- a/tests/test_unit.lsp +++ b/tests/test_unit.lsp @@ -2771,6 +2771,68 @@ ) +;; ------------------------------------------------------------ +;; TESTS: check_hoehen.lsp - Phase 3 (Buehnen-Familien), reine Kerne +;; ------------------------------------------------------------ +(defun tu-tests-hoehen-fam ( / _els) + (princ "\n[check_hoehen/Phase 3 Familien]") + + ;; --- ch-familien: transitive Verbindung, Sortierung nach ID-Nummer --- + (tu-eq "ch-familien/einzeln-und-kette" + '(("b") ("c" "a" "d") ("e")) + (ch-familien '(("a" 3) ("b" 1) ("c" 2) ("d" 5) ("e" 4)) + '(("a" "c") ("c" "d") ("x" "a")))) + (tu-eq "ch-familien/kette-ueber-mittleren" + '(("a" "b" "c")) + (ch-familien '(("a" 1) ("b" 2) ("c" 3)) '(("a" "b") ("b" "c")))) + (tu-eq "ch-familien/ohne-kanten" + '(("a") ("b")) + (ch-familien '(("a" 1) ("b" 2)) nil)) + (tu-eq "ch-familien/ring" + '(("a" "b" "c")) + (ch-familien '(("a" 1) ("b" 2) ("c" 3)) '(("a" "b") ("b" "c") ("c" "a")))) + + ;; --- ch-kreuz-abzug --- + (tu-eq "ch-kreuz-abzug/kein" '("kein" . 0.0) (ch-kreuz-abzug 0.0 0.0 5000.0 5000.0 1500.0)) + (tu-eq "ch-kreuz-abzug/konflikt" '("konflikt" . 0.0) (ch-kreuz-abzug 1.5 0.0 5000.0 5000.0 1500.0)) + (tu-eq "ch-kreuz-abzug/konflikt2" '("konflikt" . 0.0) (ch-kreuz-abzug 1.5 2.0 5000.0 5000.0 1500.0)) + (tu-eq "ch-kreuz-abzug/hoehe" '("hoehe" . 0.0) (ch-kreuz-abzug 1.5 1.5 5000.0 6600.0 1500.0)) + (tu-eq "ch-kreuz-abzug/grenze" '("abzug" . 1.5) (ch-kreuz-abzug 1.5 1.5 5000.0 6500.0 1500.0)) + (tu-eq "ch-kreuz-abzug/abzug" '("abzug" . 1.5) (ch-kreuz-abzug 1.5 1.5 5000.0 5200.0 1500.0)) + + ;; --- ch-strecke-abzug (Familiensaetze: idx handles z b) --- + (tu-eq "ch-strecke-abzug/innen" + '("innen" . 1.5) + (ch-strecke-abzug '(1 ("a") 5000.0 1.5) '(1 ("a") 5000.0 1.5) 1500.0)) + (tu-eq "ch-strecke-abzug/innen-ohne-buehne" + '("innen" . 0.0) + (ch-strecke-abzug '(1 ("a") 5000.0 0.0) '(1 ("a") 5000.0 0.0) 1500.0)) + (tu-eq "ch-strecke-abzug/zwischen" + '("abzug" . 1.5) + (ch-strecke-abzug '(1 ("a") 5000.0 1.5) '(2 ("b") 5400.0 1.5) 1500.0)) + + ;; --- ch-abzug-anwenden --- + (tu-eqf "ch-abzug-anwenden/normal" 2.5 (ch-abzug-anwenden 3.5 1.0)) + (tu-nil "ch-abzug-anwenden/gleich" (ch-abzug-anwenden 3.5 3.5)) + (tu-nil "ch-abzug-anwenden/groesser" (ch-abzug-anwenden 3.5 4.0)) + (tu-nil "ch-abzug-anwenden/null" (ch-abzug-anwenden 3.5 0.0)) + + ;; --- ch-kreisel-finden: Kreisel r=400, Achse (400,0)-(2400,0) bzw. (400,5000)-(2400,5000) --- + (setq _els (list (tu-bp-el "KREISEL" 0.0 0.0 5000.0 0.0 2000.0 "K1") + (tu-bp-el "KREISEL" 0.0 5000.0 5000.0 0.0 2000.0 "K2"))) + (tu-eq "ch-kreisel-finden/auf-achse" + "K1" (ch-kreisel-finden '(1000.0 100.0 5000.0) 5000.0 _els 300.0 100.0)) + (tu-eq "ch-kreisel-finden/zweiter" + "K2" (ch-kreisel-finden '(1000.0 4900.0 5000.0) 5000.0 _els 300.0 100.0)) + (tu-eq "ch-kreisel-finden/hinter-dem-rad" + "K1" (ch-kreisel-finden '(-200.0 0.0 5000.0) 5000.0 _els 300.0 100.0)) + (tu-nil "ch-kreisel-finden/zu-weit" + (ch-kreisel-finden '(1000.0 1000.0 5000.0) 5000.0 _els 300.0 100.0)) + (tu-nil "ch-kreisel-finden/falsche-hoehe" + (ch-kreisel-finden '(1000.0 0.0 5300.0) 5300.0 _els 300.0 100.0)) +) + + (defun c:TEST_UNIT ( / out-dir report) (tu-reset) (princ "\n================================================================") @@ -2783,7 +2845,7 @@ "tu-tests-export" "tu-tests-hoehen" "tu-tests-gf" "tu-tests-omni" "tu-tests-kreisel" "tu-tests-kreisel-bp" "tu-tests-sepliste" "tu-tests-json" "tu-tests-geruest" "tu-tests-sepscan" "tu-tests-vfl-segs" "tu-tests-vfl-abbruch" - "tu-tests-werkzeuge" "tu-tests-kf") + "tu-tests-werkzeuge" "tu-tests-kf" "tu-tests-hoehen-fam") (tu-run-block fn)) (princ "\n\n----------------------------------------------------------------") diff --git a/tests/test_unit.scr b/tests/test_unit.scr index 871cc6d..d9dca44 100644 --- a/tests/test_unit.scr +++ b/tests/test_unit.scr @@ -11,6 +11,7 @@ (load (strcat (getenv "DXFM_LISP") "/GeruestInsert.lsp") "GeruestInsert.lsp nicht gefunden") (load (strcat (getenv "DXFM_LISP") "/count_sep_scan.lsp") "count_sep_scan.lsp nicht gefunden") (load (strcat (getenv "DXFM_LISP") "/KettenFoerderer.lsp") "KettenFoerderer.lsp nicht gefunden") +(load (strcat (getenv "DXFM_LISP") "/check_hoehen.lsp") "check_hoehen.lsp nicht gefunden") (load (strcat (getenv "DXFMAKRO") "/tests/test_unit.lsp")) (c:TEST_UNIT) (command "_.QUIT")