Schoenenberger_Systeme_GmbH/dxfmakros
7
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

feat: HOEHEN_CHECK Phase 3 (Buehnen-Familien), Menueeintrag und Rueckfrage vor EXPORTSIVAS

Browse Source 
Co-Authored-By: Claude Sonnet 5.5 <noreply@anthropic.com>
This commit is contained in:
Yuelin Wang
2026-10-26 10:50:34 +01:00
parent 2befdf2c33
commit f9eb41cdcc
10 changed files with 418 additions and 21 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/check_hoehen.lsp
+304 -19
View File
@@ -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)
Lisp/export.lsp
+21
View File
@@ -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")
doc/kommandos.md
+1 -1
View File
@@ -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
lang/de_DE.json
+11
View File
@@ -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",
lang/en_GB.json
+11
View File
@@ -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",
menu/SSG_LIB.mnl
+4
View File
@@ -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
menu/SSG_LIB.mnu
+1
View File
@@ -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]
tests/test_export_all.lsp
+1
View File
@@ -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))
tests/test_unit.lsp
+63 -1
View File
@@ -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----------------------------------------------------------------")
tests/test_unit.scr
+1
View File
@@ -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")