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

[MERGE] Lager branch in main

Browse Source
This commit is contained in:
Simon Hensch
2026-10-30 11:44:19 +01:00
parent 473aeec5bf 989ee398ce
commit 5821619e12
96 changed files with 9707 additions and 727 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/Jam_Edit.lsp
+183
View File
@@ -0,0 +1,183 @@
;; ============================================================
;; JAM_EDIT.LSP - Staubereich (JAM_AREA) bearbeiten
;;
;; Die Staubereiche zeichnet sps_skel (lib/tro_annotate.py --anlage) als
;; Block JAM_AREA: ein Rechteck, darin der Name Jam<NNNN>_<k>. Attribute
;; NAME sichtbar - Jam0054_3
;; CONVEYOR, NUMBER unsichtbar - Foerderer NNNN und laufende Nummer k
;; TRO, ENTRY unsichtbar - TRO und Eingang, in den er fuehrt
;; (stabiler Schluessel, nicht aendern)
;; AREA unsichtbar - Kennung der TRO-JSON (J0039)
;; AUTO unsichtbar - von sps_skel abgeleitete Nummer NNNN_k
;;
;; Aufruf JAM_EDIT:
;; - Doppelklick auf den Staubereich -> ***DOUBLECLICK [INSERT] -> SSG_BLOCKEDIT
;; - EATTEDIT -> c:EATTEDIT -> SSG_BLOCKEDIT
;; - direkt: JAM_EDIT
;; Der Dispatcher SSG_BLOCKEDIT (SSG_LIB_Commands.lsp) leitet Blocknamen
;; "JAM_*" hierher.
;;
;; Der Dialog aendert nur die Zeichnung. In die SCL kommt die Aenderung mit
;; tro_annotate.bat --file <csv> --read-jams (-> cfg/<csv>_jam_names.ini)
;; scl_skeleton.bat --json <csv>_anlage.json --templates
;;
;; Setzt ssg_core.lsp (ssg-start/ssg-end, ssg-attrib-*) und ssg_lang.lsp voraus.
;; ============================================================
;; ------------------------------------------------------------
;; Nur Ziffern, nicht leer
;; ------------------------------------------------------------
(defun jam-ziffern-p (s)
(and s (/= s "") (not (wcmatch s "*[~0-9]*")))
)
;; ------------------------------------------------------------
;; Name aus Foerderer und Nummer: "0054" "3" -> "Jam0054_3"
;; ------------------------------------------------------------
(defun jam-name (foerderer nummer)
(strcat "Jam" foerderer "_" nummer)
)
;; ------------------------------------------------------------
;; Gibt es den Namen schon an einem anderen Staubereich?
;; Liefert die Kennung (AREA) des anderen Blocks oder nil.
;; ------------------------------------------------------------
(defun jam-name-belegt (name eigener / ss i ent attribs treffer)
(setq treffer nil)
(if (setq ss (ssget "_X" (list '(0 . "INSERT") '(2 . "JAM_*"))))
(progn
(setq i 0)
(while (and (null treffer) (setq ent (ssname ss i)))
(if (not (eq ent eigener))
(progn
(setq attribs (ssg-attrib-read ent))
(if (= (strcase (cond ((cdr (assoc "NAME" attribs))) (""))) (strcase name))
(setq treffer (cond ((cdr (assoc "AREA" attribs))) ("?")))
)
)
)
(setq i (1+ i))
)
)
)
treffer
)
;; ------------------------------------------------------------
;; C:JAM_EDIT - Dialog fuer einen Staubereich
;; ------------------------------------------------------------
(defun c:JAM_EDIT ( / ss ent ed bname attribs
alt-conv alt-nr auto tro entry area
neu-conv neu-nr auto-conv auto-nr pos
dcl-pfad dat ergebnis name andere)
;; Implied Selection VOR ssg-start pruefen (ssg-start hebt Selektion auf)
(setq ss (ssget "I"))
(if (and ss (= (sslength ss) 1)
(= (cdr (assoc 0 (entget (ssname ss 0)))) "INSERT"))
(setq ent (ssname ss 0))
)
(ssg-start "JAM_EDIT" nil)
(if (null ent)
(progn
(princ (ssg-text "cmd-block-auswaehlen"))
(setq ss (ssget ":S" '((0 . "INSERT"))))
(if ss (setq ent (ssname ss 0)))
)
)
(if (null ent)
(progn (princ (ssg-text "cmd-kein-block-ausgewaehlt")) (ssg-end) (exit))
)
(setq ed (entget ent)
bname (cdr (assoc 2 ed)))
(if (not (wcmatch bname "JAM_*"))
(progn
(alert (ssg-textf "jam-edit-kein-jam" (list bname)))
(ssg-end)
(exit)
)
)
;; --- aktuelle Attribute lesen ----------------------------------------
(setq attribs (ssg-attrib-read ent)
alt-conv (cond ((cdr (assoc "CONVEYOR" attribs))) (""))
alt-nr (cond ((cdr (assoc "NUMBER" attribs))) (""))
auto (cond ((cdr (assoc "AUTO" attribs))) (""))
tro (cond ((cdr (assoc "TRO" attribs))) ("?"))
entry (cond ((cdr (assoc "ENTRY" attribs))) ("?"))
area (cond ((cdr (assoc "AREA" attribs))) ("?")))
;; AUTO "0054_3" -> Foerderer "0054", Nummer "3"
(setq auto-conv "" auto-nr "")
(if (setq pos (vl-string-search "_" auto))
(setq auto-conv (substr auto 1 pos)
auto-nr (substr auto (+ pos 2)))
)
;; --- Dialog -----------------------------------------------------------
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/jam_edit.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "jam_edit" dat))
(progn
(alert (ssg-textf "jam-edit-dialog-fehlt" (list dcl-pfad)))
(ssg-end)
(exit)
)
)
(set_tile "bereich" (ssg-textf "jam-edit-bereich" (list area tro entry)))
(set_tile "auto" (ssg-textf "jam-edit-auto"
(list (if (= auto "") "-" (jam-name auto-conv auto-nr)))))
(set_tile "hinweis" (ssg-text "jam-edit-hinweis"))
(set_tile "conveyor" alt-conv)
(set_tile "number" alt-nr)
(if (= auto "") (mode_tile "reset" 1))
(setq neu-conv alt-conv neu-nr alt-nr)
(action_tile "reset"
"(set_tile \"conveyor\" auto-conv) (set_tile \"number\" auto-nr)")
(action_tile "accept"
(strcat "(setq neu-conv (vl-string-trim \" \" (get_tile \"conveyor\"))"
" neu-nr (vl-string-trim \" \" (get_tile \"number\")))"
"(done_dialog 1)"))
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
;; --- pruefen und zurueckschreiben -------------------------------------
(if (= ergebnis 1)
(cond
((not (and (jam-ziffern-p neu-conv) (= (strlen neu-conv) 4)))
(alert (ssg-text "jam-edit-foerderer-ungueltig")))
((not (and (jam-ziffern-p neu-nr) (> (atoi neu-nr) 0)))
(alert (ssg-text "jam-edit-nummer-ungueltig")))
(t
(setq neu-nr (itoa (atoi neu-nr))
name (jam-name neu-conv neu-nr))
(ssg-attrib-set-on ent (list (cons "CONVEYOR" neu-conv)
(cons "NUMBER" neu-nr)
(cons "NAME" name)))
(entupd ent)
(princ (ssg-textf "jam-edit-gespeichert" (list name area)))
(if (setq andere (jam-name-belegt name ent))
(princ (ssg-textf "jam-edit-doppelt" (list name andere)))
)
)
)
)
(ssg-end)
(princ)
)
(prompt "\nJam_Edit.lsp geladen - Befehl: JAM_EDIT")
(princ)
Lisp/KettenFoerderer.lsp
+1206
View File
File diff suppressed because it is too large Load Diff
Lisp/KreiselInsert.lsp
+143 -91
View File
@@ -420,6 +420,18 @@
att-entity att-data att-tag new-value
beforeAtt)
;; Mindestabstand: unterhalb des Durchmessers wuerden sich die Endkreise
;; (AN8/SP8) beruehren bzw. ueberschneiden - harte Sperre fuer alle Aufrufer
;; (Insert/Connect/Redraw/Edit/Script), da draw-module der einzige
;; gemeinsame Zeichenpfad ist.
(if (< abstand *kreisel-durchmesser*)
(progn
(ssg-emsg (ssg-textf "kreisel-emsg-abstand-zu-klein"
(list (rtos abstand 2 0) (rtos *kreisel-durchmesser* 2 0))))
(exit)
)
)
;; Attribute vorbereiten
(setq attribs (ssg-attrib-merge attribs *kreisel-attrib-defs*))
(setq attribs (subst (cons "ABSTAND" (rtos abstand 2 0))
@@ -695,11 +707,23 @@
)
;; 2. Abstand (Tangentenlaenge) - Linie gibt auch den Winkel vor
(setq p2 (getpoint pt (ssg-textf "kreisel-prompt-abstand"
(list (rtos *kreisel-default-laenge* 2 0)))))
(setq erg (kreisel-insert-richtung pt p2 *kreisel-default-laenge*)
abstand (car erg)
rotation (cadr erg))
;; Mindestabstand = Kreisel-Durchmesser (sonst beruehren/ueberschneiden
;; sich die Endkreise) - bei Unterschreitung erneut abfragen.
(setq abstand nil)
(while (null abstand)
(setq p2 (getpoint pt (ssg-textf "kreisel-prompt-abstand"
(list (rtos *kreisel-default-laenge* 2 0)))))
(setq erg (kreisel-insert-richtung pt p2 *kreisel-default-laenge*)
abstand (car erg)
rotation (cadr erg))
(if (< abstand *kreisel-durchmesser*)
(progn
(ssg-emsg (ssg-textf "kreisel-emsg-abstand-zu-klein"
(list (rtos abstand 2 0) (rtos *kreisel-durchmesser* 2 0))))
(setq abstand nil)
)
)
)
(princ (ssg-textf "kreisel-abstand-ausgabe" (list (rtos abstand 2 0))))
;; 3. Hoehe (Z-Koordinate)
@@ -747,24 +771,29 @@
(progn (ssg-end) (princ (ssg-text "kreisel-abgebrochen")) (princ) (exit))
)
;; 2. Endpunkt (aeusserster Punkt SP-Seite) mit Gummiband
(setq ptEnd (getpoint ptStart (ssg-text "kreisel-prompt-endpunkt")))
(if (null ptEnd)
(progn (ssg-end) (princ (ssg-text "kreisel-abgebrochen")) (princ) (exit))
)
;; 2. Endpunkt (aeusserster Punkt SP-Seite) mit Gummiband - der Abstand
;; (Kreismitten-Tangentenlaenge = dist - Durchmesser) muss mindestens dem
;; Durchmesser entsprechen, sonst beruehren/ueberschneiden sich die
;; Endkreise; bei Unterschreitung erneut abfragen statt abzubrechen.
(setq abstand nil)
(while (null abstand)
(setq ptEnd (getpoint ptStart (ssg-text "kreisel-prompt-endpunkt")))
(if (null ptEnd)
(progn (ssg-end) (princ (ssg-text "kreisel-abgebrochen")) (princ) (exit))
)
;; 3. Geometrie berechnen
(setq dx (- (car ptEnd) (car ptStart))
dy (- (cadr ptEnd) (cadr ptStart)))
(setq dist (sqrt (+ (* dx dx) (* dy dy))))
(setq abstand (- dist *kreisel-durchmesser*))
;; 3. Geometrie berechnen
(setq dx (- (car ptEnd) (car ptStart))
dy (- (cadr ptEnd) (cadr ptStart)))
(setq dist (sqrt (+ (* dx dx) (* dy dy))))
(setq abstand (- dist *kreisel-durchmesser*))
(if (<= abstand 0.0)
(progn
(ssg-emsg (ssg-textf "kreisel-emsg-distanz-klein"
(list (rtos dist 2 0) (rtos *kreisel-durchmesser* 2 0))))
(ssg-end)
(exit)
(if (< abstand *kreisel-durchmesser*)
(progn
(ssg-emsg (ssg-textf "kreisel-emsg-distanz-klein"
(list (rtos dist 2 0) (rtos (* 2.0 *kreisel-durchmesser*) 2 0))))
(setq abstand nil)
)
)
)
@@ -883,7 +912,7 @@
;; geaendertem) Abstand neu. Alle Attribute bleiben
;; erhalten.
;; -----------------------------------------------
(defun c:KreiselRedraw ( / sel ent ed attribs basePoint rotation newAbstand)
(defun c:KreiselRedraw ( / sel ent ed attribs basePoint rotation newAbstand gueltig)
(ssg-start (ssg-text "kreisel-start-redraw") '(("CECOLOR")))
@@ -910,11 +939,20 @@
(cdr (assoc "HOEHE" attribs))
(cdr (assoc "KREISELART" attribs)))))
;; 3. Neuen Abstand abfragen (Enter = beibehalten)
(initget 6)
(setq newAbstand (getdist (ssg-textf "kreisel-prompt-neuer-abstand" (list (cdr (assoc "ABSTAND" attribs))))))
(if (null newAbstand)
(setq newAbstand (atof (cdr (assoc "ABSTAND" attribs))))
;; 3. Neuen Abstand abfragen (Enter = beibehalten); Mindestabstand =
;; Kreisel-Durchmesser, sonst beruehren/ueberschneiden sich die Endkreise.
(setq newAbstand nil gueltig nil)
(while (not gueltig)
(initget 6)
(setq newAbstand (getdist (ssg-textf "kreisel-prompt-neuer-abstand" (list (cdr (assoc "ABSTAND" attribs))))))
(if (null newAbstand)
(setq newAbstand (atof (cdr (assoc "ABSTAND" attribs))))
)
(if (< newAbstand *kreisel-durchmesser*)
(ssg-emsg (ssg-textf "kreisel-emsg-abstand-zu-klein"
(list (rtos newAbstand 2 0) (rtos *kreisel-durchmesser* 2 0))))
(setq gueltig T)
)
)
;; NEU - Neue Höhe abfragen:
(setq newHoehe (getreal (ssg-textf "kreisel-prompt-neue-hoehe" (list (cdr (assoc "HOEHE" attribs))))))
@@ -991,7 +1029,7 @@
;; 3. Bei OK: Block loeschen und mit neuen Werten neu zeichnen
;; -----------------------------------------------
(defun c:KreiselEdit ( / sel ss ent ed attribs basePoint rotation
dcl-pfad dat ergebnis
dcl-pfad dat ergebnis fertig
dlg-name dlg-abstand dlg-hoehe dlg-ausrichtung
dlg-drehrichtung dlg-kreiselart dlg-geruest-einzelmodul
dlg-geruest-typ
@@ -1049,73 +1087,87 @@
(princ (ssg-textf "kreisel-edit-bestehend"
(list (cdr (assoc "ABSTAND" attribs)) (rtos rotation 2 1) (cdr (assoc "KREISELART" attribs)))))
;; 3. DCL-Dialog laden
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/kreisel_edit.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "kreisel_edit" dat))
(progn (alert (ssg-textf "kreisel-edit-dialog-fehlt" (list dcl-pfad))) (ssg-end) (exit))
)
;; 3. DCL-Dialog laden; bei zu kleinem Abstand (< Kreisel-Durchmesser,
;; sonst beruehren/ueberschneiden sich die Endkreise) erneut anzeigen,
;; statt den fehlerhaften Wert zu uebernehmen (Projektmuster wie GERUEST).
(setq dlg-abstand (cdr (assoc "ABSTAND" attribs)))
(setq fertig nil)
(while (not fertig)
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/kreisel_edit.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "kreisel_edit" dat))
(progn (alert (ssg-textf "kreisel-edit-dialog-fehlt" (list dcl-pfad))) (ssg-end) (exit))
)
;; Ausrichtungs-Labels fuer popup_list aufbauen
(setq ausrichtLabels "")
(foreach entry *kreisel-ausrichtungen*
(if (= ausrichtLabels "")
(setq ausrichtLabels (car entry))
(setq ausrichtLabels (strcat ausrichtLabels "\n" (car entry)))
;; Ausrichtungs-Labels fuer popup_list aufbauen
(setq ausrichtLabels "")
(foreach entry *kreisel-ausrichtungen*
(if (= ausrichtLabels "")
(setq ausrichtLabels (car entry))
(setq ausrichtLabels (strcat ausrichtLabels "\n" (car entry)))
)
)
;; Tiles initialisieren (Abstand aus vorherigem Versuch uebernehmen)
(set_tile "name" (cdr (assoc "Bezeichnung" attribs)))
(set_tile "abstand" dlg-abstand)
(set_tile "hoehe" (cdr (assoc "HOEHE" attribs)))
(start_list "ausrichtung")
(foreach entry *kreisel-ausrichtungen*
(add_list (car entry))
)
(end_list)
(set_tile "ausrichtung" (itoa (kreisel-rotation-to-idx rotation)))
(start_list "drehrichtung")
(add_list "UZS")
(add_list "GUZ")
(end_list)
(set_tile "drehrichtung" (if (equal (cdr (assoc "DREHRICHTUNG" attribs)) "GUZ") "1" "0"))
(start_list "kreiselart")
(add_list "STANDARD")
(add_list "PIN")
(end_list)
(set_tile "kreiselart" (if (equal (cdr (assoc "KREISELART" attribs)) "PIN") "1" "0"))
(set_tile "geruest_einzelmodul"
(if (equal (cdr (assoc "GERUEST_EINZELMODUL" attribs)) "1") "1" "0"))
(start_list "geruest_typ")
(foreach opt *ssg-geruest-optionen* (add_list opt))
(end_list)
(set_tile "geruest_typ" (itoa (ssg-geruest-typ-to-idx (cdr (assoc "GERUEST_TYP" attribs)))))
;; Actions
(action_tile "accept"
(strcat
"(setq dlg-name (get_tile \"name\"))"
"(setq dlg-abstand (get_tile \"abstand\"))"
"(setq dlg-hoehe (get_tile \"hoehe\"))"
"(setq dlg-ausrichtung (get_tile \"ausrichtung\"))"
"(setq dlg-drehrichtung (get_tile \"drehrichtung\"))"
"(setq dlg-kreiselart (get_tile \"kreiselart\"))"
"(setq dlg-geruest-einzelmodul (get_tile \"geruest_einzelmodul\"))"
"(setq dlg-geruest-typ (get_tile \"geruest_typ\"))"
"(done_dialog 1)"
)
)
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(cond
((/= ergebnis 1) (setq fertig T))
((< (atof dlg-abstand) *kreisel-durchmesser*)
(ssg-emsg (ssg-textf "kreisel-emsg-abstand-zu-klein"
(list (rtos (atof dlg-abstand) 2 0) (rtos *kreisel-durchmesser* 2 0)))))
(t (setq fertig T))
)
)
;; Tiles initialisieren
(set_tile "name" (cdr (assoc "Bezeichnung" attribs)))
(set_tile "abstand" (cdr (assoc "ABSTAND" attribs)))
(set_tile "hoehe" (cdr (assoc "HOEHE" attribs)))
(start_list "ausrichtung")
(foreach entry *kreisel-ausrichtungen*
(add_list (car entry))
)
(end_list)
(set_tile "ausrichtung" (itoa (kreisel-rotation-to-idx rotation)))
(start_list "drehrichtung")
(add_list "UZS")
(add_list "GUZ")
(end_list)
(set_tile "drehrichtung" (if (equal (cdr (assoc "DREHRICHTUNG" attribs)) "GUZ") "1" "0"))
(start_list "kreiselart")
(add_list "STANDARD")
(add_list "PIN")
(end_list)
(set_tile "kreiselart" (if (equal (cdr (assoc "KREISELART" attribs)) "PIN") "1" "0"))
(set_tile "geruest_einzelmodul"
(if (equal (cdr (assoc "GERUEST_EINZELMODUL" attribs)) "1") "1" "0"))
(start_list "geruest_typ")
(foreach opt *ssg-geruest-optionen* (add_list opt))
(end_list)
(set_tile "geruest_typ" (itoa (ssg-geruest-typ-to-idx (cdr (assoc "GERUEST_TYP" attribs)))))
;; Actions
(action_tile "accept"
(strcat
"(setq dlg-name (get_tile \"name\"))"
"(setq dlg-abstand (get_tile \"abstand\"))"
"(setq dlg-hoehe (get_tile \"hoehe\"))"
"(setq dlg-ausrichtung (get_tile \"ausrichtung\"))"
"(setq dlg-drehrichtung (get_tile \"drehrichtung\"))"
"(setq dlg-kreiselart (get_tile \"kreiselart\"))"
"(setq dlg-geruest-einzelmodul (get_tile \"geruest_einzelmodul\"))"
"(setq dlg-geruest-typ (get_tile \"geruest_typ\"))"
"(done_dialog 1)"
)
)
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
;; 4. Bei OK: Block loeschen und neu zeichnen
(if (= ergebnis 1)
(progn
Lisp/OmniModulInsert.lsp
+6 -4
View File
@@ -1538,10 +1538,12 @@
)
;; --- Omniflo / KettenFoerderer ---
(defun c:OMNI_KettenFoerderer ()
(princ "\n[DUMMY] KettenFoerderer")
(princ)
)
;; Der Platzhalter c:OMNI_KettenFoerderer (reiner Dummy, gab nur "[DUMMY]
;; KettenFoerderer" aus und war im Menue ausgegraut) wurde entfernt: der
;; Kettenfoerderer ist seit 2026-10-22 als eigene Baugruppe umgesetzt, der
;; Menueeintrag zeigt jetzt auf (ssg-ensure "KettenFoerderer") KETTENFOERDERER
;; (Lisp/KettenFoerderer.lsp). Damit war der Dummy toter Code - auf ihn verwies
;; nur noch der Menueeintrag selbst.
;; --- Omniflo / Ladeschleifen ---
Lisp/README.md
+89 -32
View File
@@ -38,21 +38,22 @@ am Label-Anfang, bei Submenue-Schliessern hinter dem `<-` (`[<-~Label]`).
| Menuebereich | Eintraege | Definiert in |
| --- | --- | --- |
| Omniflo ▸ Anbaugruppen | `OMNI_KettenFoerderer` | `OmniModulInsert.lsp` |
| Omniflo ▸ Boegen fuer Weichen | alle `OMNI_APBW_*` (14) | `OmniModulInsert.lsp` |
| ILS ▸ Zusatzmodule/Kurven | `ILS_ETF_Etagenfoerderer`, `ILS_K{90,60,30}{L,R}{A,I}` (12), `ILS_Gefaellestrecke` | `SSG_LIB_Commands.lsp` |
| Geruest | `GERUEST` (Gattertraeger-Platzhalter, derselbe Befehl wie Saeulen/Rohrabhaenger/Wandbefestigung) | `GeruestInsert.lsp` |
`OMNI_TEF_*` (UmlenkR/L, AntriebL/R, TEF Gerade) sind entgegen frueherem Stand
**implementiert** (echtes `omni:insert-dxf`), nur `OMNI_KettenFoerderer` ist
weiterhin Dummy.
**implementiert** (echtes `omni:insert-dxf`). Der Menueeintrag KettenFoerderer ist
ebenfalls aktiv (Modul `KettenFoerderer.lsp`, Beschreibung in `CLAUDE.md`).
Aktiv (implementiert) sind u.a.: Kreisel, Eckrad, VarioFoerderer (Standard/Etage/
Linienzug), Gefaellestrecke, Geruest (Saeulen/Rohrabhaenger/Wandbefestigung/
Rohr-Geruest-Traeger), TRO-Marker, Connections, BTMT Be-/Entladung, Scanner/
Separator, Omniflo Boegen (APB)/TEF-Elemente/Aluprofil-Geraden (AP)/alle Weichen
(W90/W45/WP/WK/WKomb)/Ladeschleifen, Export (Sivas/CSV), Werkzeuge (Block-/
Text-Tools, Planquadrate) und die Tests.
(W90/W45/WP/WK/WKomb)/Ladeschleifen/Schwenkschienen/Fahrstrecke, Kettenfoerderer,
Export (Sivas/CSV), Werkzeuge (Block-/Text-Tools, Faehnchen + Stueckliste,
DIN-Formate, Planquadrate) und die Tests. Die frueheren Dummy-Befehle fuer ILS-Kurven
(`ILS_K*`), Etagenfoerderer (`ILS_ETF_*`) und `ILS_Gefaellestrecke` wurden samt
Menueeintraegen entfernt.
---
@@ -383,6 +384,10 @@ Gefaellestrecke/`vf_core` geladen sein; Kern-Modul.
| `extract-ks-from-block[-raw] name` | KS_EIN/KS_AUS-Punkte eines Blocks ermitteln (Cache `*ks-cache*`) |
| `insert-block-by-ks name ks-nr pt` | Block anhand KS-Punkt einfuegen (nur Rz-Rotation) |
| `insert-inclined-scaled-block` / `insert-rotated-block-with-ks` | Geneigten/rotierten Block mit KS-Offset einfuegen (Rz*Ry) |
| `ks-xy-winkel ks-eintrag` | Richtung der X-Achse eines KS in der XY-Ebene (Grad); `nil` bei senkrechter Achse |
| `ks-block-messen name` / `ks-versatz ks-data` | KS eines Blocks messen, ohne bleibende Einfuegung / Versatz KS_AUS-KS_EIN |
| `insert-block-ks-skaliert name pt hz skala` | Wie `insert-block-by-ks`, zusaetzlich in X skaliert |
| `insert-block-ks-matrix name pt R skala` | Einfuegen mit **freier 3x3-Rotationsmatrix** (`ks-rot-x/-y/-z`), z.B. fuer aufgerichtete Baugruppen |
---
@@ -578,9 +583,9 @@ umbiegen. Falls das bereits passiert ist, hilft nur ein manuelles
---
### `tests.lsp` – Testbefehle
### `external_call.lsp` – Python-Aufruf testen
Testbefehle für die Python-Integration. Export-Funktionen wurden in `export.lsp` ausgelagert.
Testbefehl für die Python-Integration (frueher `tests.lsp`). Export-Funktionen liegen in `export.lsp`.
| Befehl | Beschreibung |
| --- | --- |
@@ -605,7 +610,7 @@ Verzeichnisstruktur: [`../tests/README.md`](../tests/README.md)):
Welche JSON-Angaben pro Element-Typ nötig sind (abgeleitet aus den
Produktions-Routinen, nicht aus den Test-Wrappern), dokumentiert
[`../tests/testdata/object_data.md`](../tests/testdata/object_data.md) –
[`../doc/json-input-lisp.md`](../doc/json-input-lisp.md) (Nachfolger des geloeschten `tests/testdata/object_data.md`) –
inkl. der Unterscheidung scriptbar vs. nur-interaktiv.
### LISP-Unit-Tests (`test_unit.lsp`)
@@ -701,7 +706,7 @@ AutoLISP-Implementierung fuer alle Omniflo-Komponenten: Boegen, Weichen, Verbind
| Geraden | `OMNI_AP60`, `OMNI_AP110`, `OMNI_APG110` | Omniflo-Geradenstuecke |
| Ladeschleifen | `OMNI_LADESCHLEIFE_AP110` | Ladeschleife aus `omniflo_ladeschleifen.json` ueber DCL-Dialog (`dcl/omniflo_ladeschleifen.dcl`) einfuegen; Daten per `ssg-json-laden` (Beschreibungen enthalten Kommas). Blockdatei `<Sivasnr>.dwg` unter `DXFM_OMNIFLO` (`omni:insert-dxf` faellt auf `.dwg` zurueck, wenn keine `.dxf` existiert). Per `OMNI_EDIT` editierbar |
| TEF Elemente | `OMNI_TEF_UmlenkR/L`, `OMNI_TEF_AntriebL/R`, `OMNI_TEF_Gerade` | Feste TEF-Bauteile ohne Sivas-Auswahl, direkt per `omni:insert-dxf` an gewaehltem Punkt eingefuegt (Dateien unter `DXFM_OMNIFLO`) |
| Anbaugruppen ⚠️ | `OMNI_KettenFoerderer` | **Dummy** (noch nicht implementiert, im Menue ausgegraut); `OMNI_STOPPER`/`OMNI_SCANNER`/`OMNI_BUERSTENBREMSE` sind implementiert |
| Anbaugruppen | `OMNI_STOPPER`, `OMNI_SCANNER`, `OMNI_BUERSTENBREMSE` | Implementiert |
| Verbinder | `OMNI_TV_*` | Verbinder-DWG aus `data/omniflo/Verbinder` (dimensionsunabhaengig, `omni:insert-verbinder` -> `omni:insert-datei`, Punkt + Drehung interaktiv). Zuordnung Befehl -> DWG nach Dateiname, z.B. `OMNI_TV_W_AP60` -> `TV_W-AP60_oben`, `OMNI_TV_ENDPLATTE` -> `VB_ENDP_AP`, `OMNI_TV_W_AP60_KPL` -> `TV_W-AP60_kpl`, `OMNI_TV_ANSCHLAG` -> `VB_ENDP_AP_Spulenzug`, `OMNI_TV_SW_I_AP110` -> `TV_SW_I_SW-AP110`, `OMNI_TV_MUFFE` -> `VB_Muffe`. Alle 18 Eintraege aktiv |
| Bogenweichen ⚠️ | `OMNI_APBW_*` | **Dummy** (noch nicht implementiert, im Menue ausgegraut) |
| Bearbeiten | `OMNI_EDIT` | Omniflo-Block selektieren und Attribute bearbeiten |
@@ -712,13 +717,12 @@ nicht zu verwechseln mit den einzelnen `OMNI_TEF_*`-Befehlen oben.
---
### `SSG_LIB_Commands.lsp` – BTMT, Sensoren, Dummy-Befehle, Konfiguration und SSG_BLOCKEDIT
### `SSG_LIB_Commands.lsp` – BTMT, Sensoren, Konfiguration und SSG_BLOCKEDIT
Sammeldatei fuer Menue-Befehle: teils Platzhalter fuer noch nicht implementierte
Eintraege, teils bereits **echte** Funktionalitaet (BTMT Be-/Entladung, Sensoren,
Konfiguration, Doppelklick-Dispatcher). Alle noch offenen Dummy-Menueintraege sind in
`menu/SSG_LIB.mnu` mit `~` ausgegraut (siehe Abschnitt
["Status: noch offene Menueintraege"](#status-noch-offene-menueintraege-im-menue-ausgegraut)).
Sammeldatei fuer Menue-Befehle: BTMT Be-/Entladung, Sensoren, Eingang/Ausgang,
Konfiguration und der Doppelklick-Dispatcher. Die frueheren Dummy-Befehle (ILS-Kurven,
Etagenfoerderer) sind entfernt; noch offene Menueintraege anderer Module siehe Abschnitt
["Status: noch offene Menueintraege"](#status-noch-offene-menueintraege-im-menue-ausgegraut).
**Sensoren einfuegen** (real, ueber `ils-insert-sensor` → wiederholtes `_.INSERT`
mit interaktivem Einfuegepunkt/Rotation, Blockdatei via `ssg-ils-block-datei`):
@@ -760,15 +764,6 @@ Sivas-Export zusaetzlich in den Summenzaehlern "Anzahl aller BTBeladung"/
dieselbe `ils-insert-station`-Routine wie BTMT Be-/Entladung (frei platzierbar,
Blöcke `Eingang_<DIM>.dwg`/`Ausgang_<DIM>.dwg` in `data/ils`).
Registrierte Dummy-Befehle:
| Gruppe | Befehle |
| --- | --- |
| ILS Zusatzmodule | `ILS_ETF_Etagenfoerderer`|
| ILS Kurven angetrieben Aussen | `ILS_K90LA`, `ILS_K90RA`, `ILS_K60LA`, `ILS_K60RA`, `ILS_K30LA`, `ILS_K30RA` |
| ILS Kurven angetrieben Innen | `ILS_K90LI`, `ILS_K90RI`, `ILS_K60LI`, `ILS_K60RI`, `ILS_K30LI`, `ILS_K30RI` |
| ILS Gefaellestrecken-Kurven | `ILS_Gefaellestrecke` |
> `FOERDERANLAGE` ist nicht hier definiert – dieser Befehl ist in `VarioFoerderer.lsp` implementiert.
**Konfigurationsbefehle** (Menue → Konfiguration):
@@ -776,11 +771,12 @@ Registrierte Dummy-Befehle:
| Befehl | Beschreibung |
| --- | --- |
| `SSG_DIM_SWITCH` | Schaltet zwischen 2D/3D-Bloecken um (setzt `DXFM_DIM`, `DXFM_BLOCKS`, `DXFM_OMNIFLO`) |
| `SSG_DIM_ALL_2D` / `SSG_DIM_ALL_3D` | Alle VF_n-/GF_n-Bloecke der Zeichnung nach 2D bzw. 3D umbauen |
| `SSG_SPRACHE` | Oeffnet Dialog `sprache.dcl`, setzt `*ssg-lang*` und persistiert via `DXFM_LANG` (siehe [`ssg_lang.lsp`](#ssg_langlsp--sprachumschaltung-deutschenglisch)) |
**SSG_BLOCKEDIT** – Doppelklick/Kontextmenue-Dispatcher:
Erkennt den Blocktyp des selektierten INSERT-Blocks und ruft den passenden Bearbeitungsbefehl auf (Reihenfolge wichtig: `GR_*` **vor** dem Omniflo-Zweig, da Geruest-Bloecke ebenfalls ein TEILEART-Attribut tragen):
Erkennt den Blocktyp des selektierten INSERT-Blocks und ruft den passenden Bearbeitungsbefehl auf (Reihenfolge wichtig: `GR_*` und `KF_*` **vor** dem Omniflo-Zweig, da diese Bloecke ebenfalls ein TEILEART-Attribut tragen koennen):
| Blockmuster | Aktion |
| --- | --- |
@@ -788,8 +784,11 @@ Erkennt den Blocktyp des selektierten INSERT-Blocks und ruft den passenden Bearb
| `ECKRAD_*` | `EckradEdit` |
| `GF_*` | `GEFAELLESTRECKE_EDIT` |
| `VF_*` | `VARIOFOERDERER_EDIT` |
| `GR_*` | Geruest – `BEDIT` (kein eigener Edit-Pfad; siehe `GeruestInsert.lsp`) |
| `CONNECTION_*` | `CONNECTION_EDIT` |
| `JAM_*` | `JAM_EDIT` |
| `TRO_*` | `TRO_EDIT` |
| `GR_*` | Geruest – nativer Attribut-Editor `_.EATTEDIT` (kein eigener Edit-Pfad; siehe `GeruestInsert.lsp`) |
| `KF_*` | `KF_EDIT` |
| Omniflo (TEILEART-Attribut, AP110*, numerisch) | `OMNI_EDIT` |
| Sonstige | `BEDIT` (Block-Editor) |
@@ -800,18 +799,20 @@ Erkennt den Blocktyp des selektierten INSERT-Blocks und ruft den passenden Bearb
Rohr-Geruest-Baugruppen (Saeulen, Rohrabhaenger, Wandbefestigung, Rohr-Geruest-Traeger)
aus [`data/json/geruest.json`](../data/json/geruest.json) bzw.
[`data/json/geruest_traeger.json`](../data/json/geruest_traeger.json) konfigurieren
und einfuegen. Die Dialogdefinition wird **zur Laufzeit erzeugt**
(`geruest-dcl-schreiben`, temporaere DCL-Datei) – es gibt keine feste
`dcl/geruest.dcl`, weil je Anbauteil ein eigenes Mengenfeld gebraucht wird.
und einfuegen. Das Dialog-Layout steht als **Vorlage** in `dcl/geruest.dcl` bzw.
`dcl/geruest_traeger.dcl`; nur die datenabhaengigen Bloecke (Varianten-Radiobuttons,
Mengenfeld je Anbauteil) werden zur Laufzeit an Markerzeilen `//@NAME@` eingesetzt
(`ssg-dcl-vorlage-fuellen`, temporaere DCL-Datei).
Ausfuehrliche Beschreibung (Konfigurationen, Attribut-Schema, Querstreben/Muffe,
Traeger-Beschriftung): siehe `../CLAUDE.md` Abschnitt "AutoLISP-Module".
| Befehl | Beschreibung |
| --- | --- |
| `c:GERUEST` | Dialog ohne Vorgabe-Bereich (Dropdown Rohrabhaenger/Saeulen/Wandbefestigung) |
| `c:GERUEST_SAEULEN` / `c:GERUEST_ROHRABHAENGER` / `c:GERUEST_WANDBEFESTIGUNG` | Dialog mit vorgewaehltem Bereich (derselbe Dialog wie `GERUEST`) |
| `c:GERUEST_SAEULEN` / `c:GERUEST_ROHRABHAENGER` / `c:GERUEST_WANDBEFESTIGUNG` | Je eigener Dialog fuer den Bereich (keine Umschaltung im Dialog) |
| `c:GERUEST` | Ohne Bereich nur ein Hinweis (im Menue Platzhalter fuer den Gattertraeger) |
| `c:GERUEST_TRAEGER` | Eigener fester Dialog (`dcl/geruest_traeger.dcl`): Rohr-Geruest-Traeger mit Linien-Logik (Start-/Endpunkt oder Laenge, Laengenabzuege, Querstreben/Muffe-Verteilung) |
| `c:GERUEST_TRAEGER_BESCHRIFTEN` | Alle Traeger der Zeichnung neu beschriften (eigenes TEXT-Objekt, verknuepft per XDATA `SSG_GR_BESCHR`) |
| `c:OMNI_FAHRSTRECKE` / `c:OMNI_FAHRSTRECKE_BESCHRIFTEN` | Omniflo-Fahrstrecke mit derselben Linien-Logik (Daten `omniflo_fahrstrecke.json`, Vorlage `dcl/fahrstrecke.dcl`) bzw. Neubeschriftung |
Block-Praefix `GR_<id>_<timestamp>` – **nicht kosmetisch**: `SSG_BLOCKEDIT` muss
`GR_*` vor dem Omniflo-Zweig abfangen, da Geruest-Bloecke ebenfalls ein
@@ -908,3 +909,59 @@ in assoziativen Arrays, MINSERT-Rastern und verschachtelten Bloecken. `LAGER_EXP
ordnet jedes goh_rack zuerst ueber den Layer `LG_*_G<n>` seines obersten INSERTs
(`lg-rk-top`), erst dann ueber die Geschosskontur zu. `LG_REGALE` zeigt die Zaehlung
je Geschoss in der Befehlszeile.
---
### `Jam_Edit.lsp` – Staubereiche (SPS)
Staubereiche zeichnet sps_skel (`tro_annotate.py --anlage`) als Block `JAM_AREA`
(Name `Jam<NNNN>_<k>`).
| Befehl | Beschreibung |
| --- | --- |
| `c:JAM_EDIT` | Foerderer und laufende Nummer per Dialog (`dcl/jam_edit.dcl`) aendern; Knopf zurueck auf den abgeleiteten Wert, Warnung bei doppeltem Namen. Auch per Doppelklick (`SSG_BLOCKEDIT`, `JAM_*`) |
---
### `KettenFoerderer.lsp` – Kettenfoerderer/Schraegfoerderer Stahl
| Befehl | Beschreibung |
| --- | --- |
| `c:KETTENFOERDERER` | Baut aus `KF_UM_<winkel>` -> `KF_LAENGE` -> `KF_AN_<winkel>` plus Draufsicht `KF_2D` einen Block `KF_<n>` (Dialog `dcl/kettenfoerderer.dcl`, Daten `data/json/kettenfoerderer.json`) |
| `c:KF_EDIT` | `KF_n` bearbeiten und an derselben Stelle neu aufbauen (auch per Doppelklick) |
| `c:KF_KS_PRUEFEN` | Diagnose (nicht im Menue) |
Details (aufgerichtete Geometrie, Attribut-Schema, Sivas-Export): `../CLAUDE.md`.
---
### Werkzeuge: `ssg_stueckliste.lsp`, `DinFormate.lsp`
| Befehl | Beschreibung |
| --- | --- |
| `c:SSG_FAEHNCHEN_STUECKLISTE` | Positions-Faehnchen je Element und grob gruppierte Stuecklistentabelle, komplett aus der Zeichnung (kein Datei-Import) |
| `c:DIN_FORMATE` | DIN-Rahmen A0-A4 und optional Schriftkopf (KOPF11, DE/EN/FR/IT) aus `cfg/rahmen/` einfuegen (Dialog `dcl/dinformate.dcl`) |
---
### Export-Hilfen: `count_sep_scan.lsp`, `check_hoehen.lsp`
| Befehl | Beschreibung |
| --- | --- |
| `c:ZAEHLE_SEP_SCAN` | Scanner/Separatoren je Kreisel/VF/GF zaehlen und in `ANZAHL_SCANNER`/`ANZAHL_SEPARATOR` schreiben (laeuft auch vor jedem Export) |
| `c:HOEHEN_CHECK` | Hoehen von Kreiseln/VF/GF messen, auf 0/negativ pruefen und in die Hoehen-Attribute schreiben |
---
### Entwickler-/Pflege-Module
| Datei | Befehle | Zweck |
| --- | --- | --- |
| `addattribute.lsp` | `ILS_ATTR_SYNC`, `ILS_ATTR_REPLACE` | ATTDEFs der Block-DWGs mit `data/ils/allocations.json` abgleichen |
| `collect_attributes.lsp` | `ILS_ATTR_COLLECT` | ATTDEF-Werte aller DWGs nach `allocations_collected.json` schreiben |
| `list_blocks.lsp` | `ILS_BLOCK_LIST` | Sub-Block-Definitionen aller DWGs auflisten (Kollisionen 2D/3D) |
| `purge_blocks.lsp` | `ILS_BLOCK_PURGE` | Unbenutzte Bloecke/Layer in allen DWGs entfernen |
| `ks_pruefung.lsp` | `KS_PRUEFEN` | KS_EIN/KS_AUS der 2D- gegen die 3D-Variante vergleichen (CSV) |
| `menu-inventory.lsp` | `MenuInventory` | BricsCAD-Menuegruppen, Plugins, Startdateien auflisten |
| `EtageVarioFoerderer.lsp` | - | Kompatibilitaets-Wrapper, laedt `vf_core.lsp` |
| `tro_types.lsp` | - | Von `tro_annotate.py --emit-lisp` erzeugte TRO-Typliste |
Lisp/SSG_LIB_Commands.lsp
+46 -2
View File
@@ -226,6 +226,7 @@
(if (car (atoms-family 1 '("SSG-ENSURE")))
(progn (ssg-ensure "Gefaellestrecke") (ssg-ensure "VarioFoerderer")))
(setq enames '() n-gf 0 n-vf 0 n-skip 0)
(setq *vfl-konvert-fehler* nil) ; Fehlschlaege der Linienzug-Konvertierung
(ssg-start "SSG_DIM_BATCH" '(("OSMODE") ("ATTREQ") ("ATTDIA")))
(setvar "OSMODE" 0)
;; Erst alle enames sammeln (entdel veraendert die Zeichnung waehrend der Iteration)
@@ -247,12 +248,12 @@
(if (gf-konvertiere-ent ent ziel-dim) (setq n-gf (1+ n-gf))))
((wcmatch bname "VF_*")
;; VF_-Bloecke nach Edit-Marker unterscheiden: Standard/Etage
;; ueber vf-konvertiere-ent, Linienzug (Modus 1/2) ueber den
;; ueber vf-konvertiere-ent, Linienzug (Modus 1/2/3) ueber den
;; Journal-Replay-Konverter vfl-konvertiere-ent. Altbestand ohne
;; bekannten Marker wird uebersprungen.
(setq marker (car (vfs-xdata-lesen ent)))
(cond
((member marker '("linienzug" "linienzug2"))
((member marker '("linienzug" "linienzug2" "linienzug3"))
(if (vfl-konvertiere-ent ent ziel-dim) (setq n-vf (1+ n-vf))
(setq n-skip (1+ n-skip))))
((member marker '("standard" "etage"))
@@ -264,6 +265,14 @@
(ssg-end)
(princ (ssg-textf "dim-batch-fertig"
(list ziel-dim (itoa n-gf) (itoa n-vf) (itoa n-skip))))
;; Fehlgeschlagene Linienzug-Bloecke gesammelt ausgeben (alter Block blieb
;; jeweils unveraendert stehen, siehe vfl-konvertiere-ent)
(if *vfl-konvert-fehler*
(progn
(princ (ssg-textf "dim-batch-fehlerliste"
(list (itoa (length *vfl-konvert-fehler*)))))
(foreach f *vfl-konvert-fehler*
(princ (ssg-textf "dim-batch-fehler-zeile" (list (car f) (cdr f)))))))
(princ)
)
@@ -382,6 +391,23 @@
)
)
;; Staubereiche (JAM_AREA) -> JAM_EDIT (DCL-Dialog)
;; Ebenfalls aus der Beschriftung von sps_skel (tro_annotate.py --anlage);
;; Foerderer und laufende Nummer des Staubereichs Jam<NNNN>_<k>.
((wcmatch bname "JAM_*")
(princ (ssg-textf "cmd-jam-bearbeiten" (list bname)))
(if (and (null *ssg-Jam_Edit-loaded*) (atoms-family 1 '("SSG-ENSURE")))
(ssg-ensure "Jam_Edit")
)
(if (atoms-family 1 '("C:JAM_EDIT"))
(c:JAM_EDIT)
(progn
(princ (ssg-textf "tro-edit-modul-fehlt" (list "Jam_Edit.lsp")))
(command "_.EATTEDIT")
)
)
)
;; TRO-Marker (TRO_SYM_<Typ>) -> TRO_EDIT (DCL-Dialog)
;; Die Marker kommen aus sps_skel (lib/tro_annotate.py) und tragen die
;; Attribute ID und TYPE. Modul bei Bedarf nachladen, damit der Doppelklick
@@ -418,6 +444,24 @@
(ssg-end)
)
;; Kettenfoerderer (KF_n, KettenFoerderer.lsp) -> KF_EDIT (DCL-Dialog mit
;; Neuaufbau an derselben Stelle). MUSS - aus demselben Grund wie GR_* -
;; vor dem Omniflo-Zweig stehen: traegt die Baugruppe ein TEILEART-
;; Attribut, wuerde dort sonst der Omniflo-Elementdialog aufgehen.
((wcmatch bname "KF_*")
(princ (ssg-textf "cmd-kettenfoerderer-bearbeiten" (list bname)))
(if (and (null *ssg-KettenFoerderer-loaded*) (atoms-family 1 '("SSG-ENSURE")))
(ssg-ensure "KettenFoerderer")
)
(if (atoms-family 1 '("C:KF_EDIT"))
(c:KF_EDIT)
(progn
(princ (ssg-textf "tro-edit-modul-fehlt" (list "KettenFoerderer.lsp")))
(command "_.EATTEDIT")
)
)
)
;; Omniflo-Bloecke -> OMNI_EDIT
;; Erkennung: TEILEART-Attribut vorhanden, AP110-Blockname oder rein numerisch
((progn
Lisp/check_hoehen.lsp
+315 -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,275 @@
)
;;; ============================================================
;;; 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))
)
;;; Flache Schleife (reiner Kern): Strecke startet und endet am SELBEN Kreisel
;;; (h1 = h2) und hat gleiche Anfangs-/Endhoehe (|z1 - z2| <= tol, mm). Ihre
;;; Buehne laesst sich nicht aus der Familie ableiten und wird einzeln gefragt.
(defun ch-schleife-p (h1 h2 z1 z2 tol)
(and h1 h2 (= h1 h2) (<= (abs (- z1 z2)) tol))
)
;;; 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)
(if (ch-schleife-p fs fe (caddr (nth 4 rec)) (caddr (nth 5 rec)) 1.0)
;; Flache Schleife am selben Kreisel: Buehne nicht ableitbar ->
;; bleibt unentschieden und wird im Rest einzeln gefragt
(princ (ssg-textf "chh-schleife" (list lbl)))
(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 +583,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 +640,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 +654,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 +691,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 +713,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 +725,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 +745,4 @@
)
(princ "\n>>> check_hoehen.lsp geladen (Phase 1-3). Befehl: HOEHEN_CHECK")
(princ)
(princ)
Lisp/export.lsp
+46
View File
@@ -2397,6 +2397,11 @@
;; VB_*/TV_* = Omniflo-Verbinder (siehe pattern_verbinder in
;; cfg/export.cfg, OMNI_TV_* in OmniModulInsert.lsp). export_sivas.py
;; fuehrt sie ueber TEILEART/ARTINR im allgemeinen Omniflo-Zweig.
;; KF_* = Kettenfoerderer/Schraegfoerderer Stahl (siehe
;; pattern_kettenfoerderer in cfg/export.cfg, KettenFoerderer.lsp). Wie
;; GR_* eine selbst zusammengebaute Baugruppe mit eigenen Attributen
;; (TEILEART/ARTINR), darum eigenstaendig gesammelt - die drei Bausteine
;; darin werden NICHT einzeln gezaehlt.
;; Bloecke auf GEFRORENEN Layern (und die Hilfsobjekte gefrorener VF_n/GF_n)
;; werden ausgelassen, solange *csv-gefrorene-ausschliessen* an ist (Standard,
;; Dialog CSV_EXPORT_KONFIG); ausgeschaltete Layer zaehlen nicht als gefroren.
@@ -2449,6 +2454,7 @@
(wcmatch bname (export:pattern "pattern_ausgang" "Ausgang*"))
(wcmatch bname (export:pattern "pattern_geruest" "GR_*"))
(wcmatch bname (export:pattern "pattern_verbinder" "VB_*,TV_*"))
(wcmatch bname (export:pattern "pattern_kettenfoerderer" "KF_*"))
(wcmatch bname (export:pattern "pattern_unit_marker" "ZZ_UNIT_MARKER*"))
;; Rein numerische Namen = Omniflo SivasNr (Boegen/Weichen)
;; Rein LISP-intern (Python klassifiziert Omniflo stattdessen
@@ -2915,8 +2921,48 @@
)
;; 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")))))
)
;; Vor dem Sivas-Export die Zeichnung bereinigen (BricsCAD-Befehl BEREINIG /
;; PURGE): entfernt unbenutzte Bloecke, Layer, Linientypen usw. samt
;; verschachtelter Elemente. Sprachunabhaengig ueber -PURGE mit "_All".
;; Schalter *csv-bereinigen-vor-export* (Standard an; Tests schalten ab, da
;; die Zeichnung veraendert wird).
(if (null *csv-bereinigen-vor-export*) (setq *csv-bereinigen-vor-export* 'an))
(defun csv:bereinigen ()
(if (and (eq *csv-bereinigen-vor-export* 'an) (ssg-gui-p))
(progn
(princ (ssg-text "exp-bereinigen"))
;; Zweimal, weil das Entfernen eines Blocks dessen Layer/Linientypen
;; erst frei macht (zusaetzlich zur Nested-Option)
(repeat 2
(vl-catch-all-apply
'(lambda () (command "_.-PURGE" "_All" "*" "_No"))))
(princ))))
;; --- EXPORTSIVAS: Sivas-spezifischer CSV-Export mit Summierungszeilen ---
(defun c:EXPORTSIVAS ()
(csv:bereinigen)
(csv:hoehencheck-anbieten)
(csv:run-export "EXPORTSIVAS"
(export:filename "sivas_script")
(export:filename "sivas_csv")
Lisp/ssg_core.lsp
+7
View File
@@ -1264,6 +1264,13 @@
("L_VF_m" "0.000")
("ANTRIEBFAHRTRICHTUNG" "Auf")
("VF_WINKEL" "0")
;; Hoehe je VF-SEGMENT in Metern (3 Nachkommastellen), kommagetrennt und
;; Eintrag fuer Eintrag parallel zu L_VF_m/VF_WINKEL: Mittelwert aus KS_EIN
;; und KS_AUS des jeweiligen geraden VF-Abschnitts (vf-vfhoehe-segment in
;; vf_core.lsp, erfasst in vfs-vf-koerper). Zwischen Umlenk- und
;; Motorstation koennen mehrere Abschnitte liegen (auf/ab/horizontal).
;; Sivas-Merkmale 4433-4437 (bis zu fuenf Abschnitte je Gruppe).
("VF_HOEHE_m" "0.000")
("VF_Bogen_A_90" "0")
("VF_Bogen_A_60" "0")
("VF_Bogen_A_30" "0")
Lisp/ssg_dbg.lsp
+13 -1
View File
@@ -86,8 +86,20 @@
;; Einheiten-Proxies selbst ab; Separator-/Element-
;; Kopien sammeln sich dagegen an - Zeichnung mit
;; eingeschaltetem Schalter nicht speichern.
;; kf-zeit - Zwischenzeiten beim Aufruf von KETTENFOERDERER
;; (Daten lesen / Dialogaufbau), siehe kf-zeit in
;; KettenFoerderer.lsp. Standard 0 - nur einschalten,
;; wenn der Dialog spuerbar verzoegert erscheint.
;; testlauf - Laufprotokoll je Test von SSG_RUN_ALL_TESTS nach
;; DXFM_LOG/testlauf_<name>.dbg (eigene Datei, nicht
;; ueber *dbg-path*; jede Zeile sofort geschrieben,
;; damit bei einem haengenden Test der letzte Schritt
;; sichtbar ist). Standard 1 - kostet nur ein paar
;; Zeilen je Test, siehe testrun:log in
;; tests/test_run_all.lsp.
;; ------------------------------------------------------------
(foreach nm '(("vf-sepliste" . 1) ("csv_leave_proxies" . 0))
(foreach nm '(("vf-sepliste" . 1) ("csv_leave_proxies" . 0) ("kf-zeit" . 0)
("testlauf" . 1))
(if (not (assoc (car nm) *dbg-schalter*))
(setq *dbg-schalter* (cons nm *dbg-schalter*))))
Lisp/ssg_id.lsp
+4
View File
@@ -47,6 +47,9 @@
;; das ID-ATTDEF steht seit *geruest-attrib-defs* zur Verfuegung.
;; VB_*/TV_* (Omniflo-Verbinder, siehe pattern_verbinder in
;; cfg/export.cfg) ebenso - fest im Code wie GR_*.
;; KF_* (Kettenfoerderer, siehe pattern_kettenfoerderer in cfg/export.cfg,
;; KettenFoerderer.lsp) ebenso - das ID-ATTDEF kommt aus kf-attrib-defs, das
;; auf dem gemeinsamen Strecken-Schema aufsetzt und darum ID bereits fuehrt.
;; Gefaellebogen_* (siehe pattern_nested_bogen in cfg/export.cfg): einer der
;; Bausteine einer GF-Kette, verpackt in VF_n/GF_n; wird beim Export ebenso
;; als temporaere Kopie ausgepackt wie die uebrigen Vario_*/Staustrecke_*-
@@ -84,6 +87,7 @@
(wcmatch bname "Eingang*,Ausgang*")
(wcmatch bname "GR_*")
(wcmatch bname "VB_*,TV_*")
(wcmatch bname "KF_*")
(wcmatch bname "#*")
)
(ssadd ename ss-out)
Lisp/ssg_ks_insert.lsp
+283 -4
View File
@@ -72,11 +72,31 @@
;; Block unter seinem effektiven, dim-suffigierten Namen und GIBT DIESEN ZURUECK,
;; damit Aufrufer ihn zum Einfuegen (vla-InsertBlock/tblsearch) verwenden.
;; Meldung nur bei Fehlschlag.
(defun ensure-block-loaded (blockname / )
(if (not (ssg-ils-block-laden blockname))
(princ (ssg-textf "vfc-fehler-block-datei-fehlt" (list blockname)))
;; Sonderfall Bloecke OHNE Dimensionssuffix (data/omniflo/<Dim>/, z.B. die
;; Kettenfoerderer-Bausteine): ssg-ils-blockname wuerde "KF_UM_26" zu
;; "KF_UM_26_2D" machen - das ist die Konvention der FLACHEN Ablage data/ils,
;; die Omniflo-Ordner arbeiten stattdessen mit getrennten Verzeichnissen und
;; unsuffigierten Namen. Liegt die Definition unter dem Rohnamen bereits in
;; der Zeichnung und gibt es KEINE suffigierte Variante, wird der Rohname
;; unveraendert verwendet. Die Bedingung ist bewusst eng gefasst (BEIDE Teile
;; muessen zutreffen), damit die Dim-Aufloesung fuer alle data/ils-Bloecke
;; unberuehrt bleibt: dort existiert die suffigierte Variante, sobald der
;; Block geladen ist, und der erste Zweig greift nie.
;; Realer Fehler, den das behebt: die KS-Messung eines KF-Bausteins lief ins
;; Leere und meldete "KS_EIN/KS_AUS fehlt", obwohl beide KS im Block vorhanden
;; waren - gesucht wurde nur ein Blockname, den es nicht gibt.
(defun ensure-block-loaded (blockname / eff)
(setq eff (ssg-ils-blockname blockname))
(if (and (not (tblsearch "BLOCK" eff))
(tblsearch "BLOCK" blockname))
blockname
(progn
(if (not (ssg-ils-block-laden blockname))
(princ (ssg-textf "vfc-fehler-block-datei-fehlt" (list blockname)))
)
eff
)
)
(ssg-ils-blockname blockname)
)
;; ------------------------------------------------------------
@@ -379,6 +399,265 @@
)
)
;; ------------------------------------------------------------
;; KS-ORIENTIERUNG + SKALIERTE KS-EINFUEGUNG
;; ------------------------------------------------------------
;; Ergaenzt fuer den Kettenfoerderer (KettenFoerderer.lsp): dort ist die
;; Neigung KEIN freier Parameter, sondern steckt fest in der Geometrie der
;; Blockvarianten (KF_UM_26 gegen KF_UM_30). Der Einbauwinkel eines
;; Folgebausteins ergibt sich darum aus der RICHTUNG des KS_AUS seines
;; Vorgaengers. Dafuer reicht der bisher allein ausgewertete KS-URSPRUNG
;; nicht - die X-Achse des KS muss mit gelesen werden. extract-ks-from-block
;; liefert sie als (origin x-end y-end z-end) bereits mit, sie wurde bislang
;; nur von keinem Aufrufer genutzt.
;; Winkel der X-Achse eines KS-Eintrags in der XY-Ebene, in Grad (-180..180).
;; ks-eintrag = (origin x-end y-end z-end), also genau der cadr-Teil eines
;; extract-ks-from-block-Ergebnisses. Rueckgabe nil, wenn die X-Achse keine
;; XY-Laenge hat (senkrecht stehendes KS) oder der Eintrag unbrauchbar ist.
(defun ks-xy-winkel (ks-eintrag / org xend dx dy)
(if (and ks-eintrag (listp ks-eintrag) (>= (length ks-eintrag) 2)
(listp (car ks-eintrag)) (listp (cadr ks-eintrag)))
(progn
(setq org (car ks-eintrag) xend (cadr ks-eintrag))
(setq dx (- (car xend) (car org))
dy (- (cadr xend) (cadr org)))
(if (< (+ (* dx dx) (* dy dy)) 1e-12)
nil
(/ (* 180.0 (atan dy dx)) pi)))
nil))
;; Winkel auf -180..180 Grad normalisieren. Reiner Rechenkern.
(defun ks-winkel-normalisieren (w)
(if (null w)
nil
(progn
(setq w (float w))
(while (> w 180.0) (setq w (- w 360.0)))
(while (<= w -180.0) (setq w (+ w 360.0)))
w)))
;; Lokalen KS_AUS-KS_EIN-Versatz eines Blocks als (dx dy dz) liefern.
;; ks-data = Ergebnis von extract-ks-from-block/ks-block-messen.
;; Rueckgabe nil, wenn eines der beiden KS fehlt.
(defun ks-versatz (ks-data / ein aus)
(setq ein (cadr (assoc "KS_EIN" ks-data))
aus (cadr (assoc "KS_AUS" ks-data)))
(if (and ein aus)
(list (- (car (car aus)) (car (car ein)))
(- (cadr (car aus)) (cadr (car ein)))
(- (caddr (car aus)) (caddr (car ein))))
nil))
;; Misst KS_EIN/KS_AUS eines Blocks, ohne eine bleibende Einfuegung zu
;; hinterlassen: der Block wird bei Massstab 1 am Ursprung eingefuegt,
;; vermessen und wieder geloescht. extract-ks-from-block cached das Ergebnis
;; je Blockname, der zweite Aufruf kostet also nichts mehr.
;; Rueckgabe wie extract-ks-from-block (Blockkoordinaten), sonst nil.
(defun ks-block-messen (blockname / eff temp-obj daten)
(setq eff (ensure-block-loaded blockname))
(if (tblsearch "BLOCK" eff)
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0)) eff 1.0 1.0 1.0 0))
(setq daten (extract-ks-from-block temp-obj))
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
daten)
nil))
;; --- Block per KS_EIN/KS_AUS einfuegen, in X SKALIERT (nur Rz-Rotation) ---
;; Wie insert-block-by-ks, zusaetzlich mit X-Massstab skala - fuer laengen-
;; variable Zwischenstuecke (Kettenfoerderer KF_LAENGE, dieselbe Rolle wie
;; die Staustrecke beim VarioFoerderer). Die lokalen KS-Punkte werden VOR der
;; Rotation in X mitskaliert; nur so liegt KS_EIN exakt auf einfuegepunkt und
;; der zurueckgegebene KS_AUS traegt den skalierten Versatz.
;; Rueckgabe: Weltpunkt von KS_AUS (fuer die Verkettung), sonst einfuegepunkt.
(defun insert-block-ks-skaliert (blockname einfuegepunkt hz skala /
block-obj ks-data ks-ein ks-aus rad-h chv shv
ein-x ein-y ein-z aus-x dx-loc dy-loc dz-loc
offset ausgang)
(if (or (null einfuegepunkt) (not (listp einfuegepunkt)))
(progn
(princ (ssg-textf "vfc-fehler-ungueltiger-einfuegepunkt" (list blockname)))
(exit))
)
(if (or (null skala) (<= skala 0.0)) (setq skala 1.0))
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek-abgebrochen" (list blockname)))
(exit))
)
(princ (ssg-textf "vfc-fuege-block-ein-hz" (list blockname (rtos (float hz) 2 1) (chr 176))))
(setq rad-h (* (float hz) (/ pi 180.0)))
(setq chv (cos rad-h) shv (sin rad-h))
;; KS am UNSKALIERTEN Block messen (der Cache arbeitet je Blockname), die
;; lokalen Punkte danach selbst in X skalieren.
(setq ks-data (ks-block-messen blockname))
(setq ks-ein (cadr (assoc "KS_EIN" ks-data)))
(setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
blockname skala 1.0 1.0 0))
(ssg-ils-block-auf-ebene block-obj blockname)
(if (> (abs hz) 0.0001)
(vla-TransformBy block-obj (vlax-tmatrix
(list (list chv (- shv) 0 0)
(list shv chv 0 0)
(list 0 0 1 0)
(list 0 0 0 1))))
)
(if (and ks-ein ks-aus)
(progn
(setq ein-x (* skala (car (car ks-ein)))
ein-y (cadr (car ks-ein))
ein-z (caddr (car ks-ein)))
(setq aus-x (* skala (car (car ks-aus))))
(setq offset (list
(- (car einfuegepunkt) (- (* chv ein-x) (* shv ein-y)))
(- (cadr einfuegepunkt) (+ (* shv ein-x) (* chv ein-y)))
(- (caddr einfuegepunkt) ein-z)))
(vla-Move block-obj
(vlax-3D-point '(0 0 0))
(vlax-3D-point offset))
(setq dx-loc (- aus-x ein-x))
(setq dy-loc (- (cadr (car ks-aus)) ein-y))
(setq dz-loc (- (caddr (car ks-aus)) ein-z))
(setq ausgang (list
(+ (car einfuegepunkt) (- (* chv dx-loc) (* shv dy-loc)))
(+ (cadr einfuegepunkt) (+ (* shv dx-loc) (* chv dy-loc)))
(+ (caddr einfuegepunkt) dz-loc)))
(ssg-sepliste-dbg
(strcat "insert-block-ks-skaliert " blockname
" hz=" (rtos (float hz) 2 2) " skala=" (rtos (float skala) 2 4)
" einfuegepunkt=" (ssg-sepliste-dbg-pt einfuegepunkt)
" offset(=Gruppencode 10)=" (ssg-sepliste-dbg-pt offset)
" ausgang=" (ssg-sepliste-dbg-pt ausgang)))
(princ (ssg-textf "vfc-ks-aus-xyz"
(list (rtos (car ausgang) 2 2) (rtos (cadr ausgang) 2 2) (rtos (caddr ausgang) 2 2))))
ausgang
)
(progn
(princ (ssg-text "vfc-warnung-ks-nicht-gefunden"))
einfuegepunkt
)
)
)
;; ------------------------------------------------------------
;; FREI ROTIERTE KS-EINFUEGUNG (beliebige 3x3-Matrix)
;; ------------------------------------------------------------
;; Verallgemeinerung von insert-block-by-ks/insert-block-ks-skaliert: statt
;; einer festen Rz- bzw. Rz*Ry-Drehung nimmt sie eine FERTIGE 3x3-Rotations-
;; matrix entgegen. Noetig geworden fuer AUFRECHT eingebaute Baugruppen: der
;; Kettenfoerderer ist in der XY-Ebene gezeichnet (X = Fahrtrichtung,
;; Y = Hoehe), soll aber im Modell stehen - seine Hoehe muss also nach Z. Das
;; ist eine Drehung um X, die weder insert-block-by-ks (nur Rz) noch
;; ssg-rot-matrix-zy (Rz*Ry) erzeugen kann.
;;
;; Bewusst matrixbasiert statt mit einem weiteren Winkelparameter: die
;; Aufrichtung ist nur EIN Anwendungsfall, und jeder weitere haette eine
;; weitere Spezialfunktion gebraucht. Den Aufrufern bleibt freigestellt,
;; welche Drehungen sie kombinieren (beim Kettenfoerderer
;; Rz(basis) * Rx(90) * Rz(eigen), siehe kf-matrix-aufrecht).
;; Elementare Rotationsmatrizen (3x3, Winkel in GRAD).
(defun ks-rot-x (grad / r c s)
(setq r (* (float grad) (/ pi 180.0)) c (cos r) s (sin r))
(list (list 1.0 0.0 0.0)
(list 0.0 c (- s))
(list 0.0 s c )))
(defun ks-rot-y (grad / r c s)
(setq r (* (float grad) (/ pi 180.0)) c (cos r) s (sin r))
(list (list c 0.0 s )
(list 0.0 1.0 0.0)
(list (- s) 0.0 c )))
(defun ks-rot-z (grad / r c s)
(setq r (* (float grad) (/ pi 180.0)) c (cos r) s (sin r))
(list (list c (- s) 0.0)
(list s c 0.0)
(list 0.0 0.0 1.0)))
;; 3x3-Rotation in die 4x4-Form bringen, die vla-TransformBy erwartet.
(defun ks-mat3->mat4 (R)
(list (append (car R) '(0.0))
(append (cadr R) '(0.0))
(append (caddr R) '(0.0))
'(0.0 0.0 0.0 1.0)))
;; --- Block per KS_EIN/KS_AUS einfuegen, frei rotiert und in X skaliert ---
;; blockname Rohname (wird ueber ensure-block-loaded aufgeloest)
;; einfuegepunkt Weltpunkt, auf den KS_EIN zu liegen kommt
;; R 3x3-Rotationsmatrix (Blockkoordinaten -> Welt)
;; skala X-Massstab (1.0 = unskaliert)
;; Rueckgabe: Weltpunkt von KS_AUS (fuer die Verkettung), sonst einfuegepunkt.
;;
;; Reihenfolge wie bei den uebrigen Primitiven: am Ursprung einfuegen,
;; skalieren, drehen, dann so verschieben, dass das GEDREHTE KS_EIN exakt auf
;; einfuegepunkt liegt. Die lokalen KS-Punkte werden dabei zuerst in X
;; mitskaliert - sonst zeigt der zurueckgegebene KS_AUS am skalierten Block
;; vorbei.
(defun insert-block-ks-matrix (blockname einfuegepunkt R skala /
block-obj ks-data ks-ein ks-aus
ein-lok aus-lok ein-welt aus-welt offset ausgang)
(if (or (null einfuegepunkt) (not (listp einfuegepunkt)))
(progn
(princ (ssg-textf "vfc-fehler-ungueltiger-einfuegepunkt" (list blockname)))
(exit))
)
(if (or (null skala) (<= skala 0.0)) (setq skala 1.0))
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek-abgebrochen" (list blockname)))
(exit))
)
(setq ks-data (ks-block-messen blockname))
(setq ks-ein (cadr (assoc "KS_EIN" ks-data)))
(setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
blockname skala 1.0 1.0 0))
(ssg-ils-block-auf-ebene block-obj blockname)
(vla-TransformBy block-obj (vlax-tmatrix (ks-mat3->mat4 R)))
(if (and ks-ein ks-aus)
(progn
;; lokale KS-Punkte, in X mitskaliert
(setq ein-lok (list (* skala (car (car ks-ein)))
(cadr (car ks-ein))
(caddr (car ks-ein))))
(setq aus-lok (list (* skala (car (car ks-aus)))
(cadr (car ks-aus))
(caddr (car ks-aus))))
(setq ein-welt (mat3-mul-vec3 R ein-lok))
(setq aus-welt (mat3-mul-vec3 R aus-lok))
(setq offset (list (- (car einfuegepunkt) (car ein-welt))
(- (cadr einfuegepunkt) (cadr ein-welt))
(- (caddr einfuegepunkt) (caddr ein-welt))))
(vla-Move block-obj
(vlax-3D-point '(0 0 0))
(vlax-3D-point offset))
(setq ausgang (list (+ (car einfuegepunkt) (- (car aus-welt) (car ein-welt)))
(+ (cadr einfuegepunkt) (- (cadr aus-welt) (cadr ein-welt)))
(+ (caddr einfuegepunkt) (- (caddr aus-welt) (caddr ein-welt)))))
(ssg-sepliste-dbg
(strcat "insert-block-ks-matrix " blockname
" skala=" (rtos (float skala) 2 4)
" einfuegepunkt=" (ssg-sepliste-dbg-pt einfuegepunkt)
" ks_ein_welt=" (ssg-sepliste-dbg-pt ein-welt)
" ks_aus_welt=" (ssg-sepliste-dbg-pt aus-welt)
" ausgang=" (ssg-sepliste-dbg-pt ausgang)))
ausgang
)
(progn
(princ (ssg-text "vfc-warnung-ks-nicht-gefunden"))
einfuegepunkt
)
)
)
;; ------------------------------------------------------------
;; SEPLISTE: Separator-/AS-/ES-Reihenfolge als XDATA am fertigen Wrapper
;; ------------------------------------------------------------
Lisp/ssg_load.lsp
+1
View File
@@ -39,6 +39,7 @@
(load (strcat base-path "OmniModulInsert.lsp") "OmniModulInsert.lsp nicht gefunden")
(load (strcat base-path "Tro_Edit.lsp") "Tro_Edit.lsp nicht gefunden")
(load (strcat base-path "Connection_Edit.lsp") "Connection_Edit.lsp nicht gefunden")
(load (strcat base-path "Jam_Edit.lsp") "Jam_Edit.lsp nicht gefunden")
(load (strcat base-path "SSG_LIB_Commands.lsp") "SSG_LIB_Commands.lsp nicht gefunden")
;; Werkzeuge: ssg_texttools nutzt ssg_blocktools, beide nutzen ssg_input
(load (strcat base-path "ssg_blocktools.lsp") "ssg_blocktools.lsp nicht gefunden")
Lisp/vf_core.lsp
+112
View File
@@ -218,6 +218,102 @@
(defun vf-motorseite-aktuell ( / )
(if (member *vf-motorseite* '("links" "rechts")) *vf-motorseite* "rechts"))
;; ============================================================
;; VF-HOEHE JE SEGMENT (Attribut VF_HOEHE_m, Sivas 4433-4437)
;; ============================================================
;; Sivas erwartet je Streckengruppe bis zu fuenf Variofoerderer-Hoehen. Ein
;; Eintrag gehoert zu EINEM VF-Segment (Koerper) - nicht zu einer ganzen
;; Foerdereinheit und nicht zur ganzen Kette (Nutzer-Korrektur 2026-10-21):
;;
;; Hoehe = Mittelwert aus KS_EIN und KS_AUS DIESES Segments.
;;
;; Eine Kette, die durch Vario-Boegen in drei Abschnitte geteilt ist, bekommt
;; dadurch drei Werte - die Liste laeuft Eintrag fuer Eintrag parallel zu
;; L_VF_m, VF_WINKEL und ANTRIEBFAHRTRICHTUNG.
;;
;; Erfasst wird an genau EINER Stelle: vfs-vf-koerper baut ein Segment, kennt
;; dessen KS_EIN als Eingangspunkt und liefert dessen KS_AUS zurueck. Alle
;; Modi (Standard, Etage, Linienzug) bauen ihre VF-Koerper darueber, deshalb
;; muss der verzweigte Bau-Pfad selbst nicht angefasst werden.
;;
;; Einheit: Meter mit 3 Nachkommastellen (wie L_VF_m), kommagetrennt ueber
;; vfl-join-komma - Reihenfolge = Bau-Reihenfolge.
(if (not (boundp '*vf-acc-vfhoehe*)) (setq *vf-acc-vfhoehe* '()))
(defun vf-vfhoehe-reset ()
(setq *vf-acc-vfhoehe* '()))
;; Ein VF-Segment erfassen: z-ein = Z des KS_EIN, z-aus = Z des KS_AUS (mm).
;; Fehlt einer der Werte, wird NICHTS angehaengt - sonst verschoebe sich die
;; Liste gegen L_VF_m/VF_WINKEL und im Export landete eine Hoehe beim falschen
;; Foerderer.
(defun vf-vfhoehe-segment (z-ein z-aus)
(if (and (numberp z-ein) (numberp z-aus))
(setq *vf-acc-vfhoehe*
(append *vf-acc-vfhoehe* (list (vf-meter-3 (/ (+ z-ein z-aus) 2.0)))))))
;; Bequemes Paar fuer die Bau-Pfade: vor dem Einbau den Startpunkt merken,
;; danach mit dem Endpunkt abschliessen. Beide geben ihren Punkt zurueck,
;; lassen sich also ohne zusaetzliche lokale Variable einsetzen:
;;
;; (vf-vfhoehe-merke pt)
;; (setq pt (insert-inclined-scaled-block ...))
;; (vf-vfhoehe-schliesse pt)
;;
;; Noetig, weil die VF-Segmente NICHT alle ueber vfs-vf-koerper laufen: die
;; horizontalen Zwischenstuecke und die Modus-2-Fuellstuecke bauen direkt mit
;; insert-inclined-scaled-block. Wurde dort nicht erfasst, fehlten ihre
;; Hoehen und VF_HOEHE_m war kuerzer als L_VF_m (realer Befund 2026-10-21:
;; L_VF_m hatte drei Eintraege, VF_HOEHE_m nur einen).
;;
;; REGEL: Jede Stelle, die (vfl-acc-vf-seg ...) aufruft, MUSS auch eine Hoehe
;; erfassen - sonst verschiebt sich die Liste gegen L_VF_m/VF_WINKEL und im
;; Sivas-Export landet eine Hoehe beim falschen Foerderer.
(if (not (boundp '*vf-vfhoehe-merk*)) (setq *vf-vfhoehe-merk* nil))
(defun vf-vfhoehe-merke (pt)
(setq *vf-vfhoehe-merk* (if (listp pt) (caddr pt) nil))
pt)
(defun vf-vfhoehe-schliesse (pt)
(vf-vfhoehe-segment *vf-vfhoehe-merk* (if (listp pt) (caddr pt) nil))
(setq *vf-vfhoehe-merk* nil)
pt)
;; SONDERFALL Standard/Etage: Hoehe ueber die GANZE Kette.
;;
;; Diese beiden Typen haben nur EINEN Motor und nur EINEN geraden
;; VF-Abschnitt (Nutzer-Vorgabe 2026-10-21). Statt des Segmentwerts gilt dort
;; der Mittelwert der ganzen Anlage:
;; Anfang = KS_EIN des AS-Elements (Startpunkt der Anlage)
;; Ende = KS_AUS des ES-Elements (Rueckgabewert der Einfuegefunktion)
;;
;; ERSETZT die Liste bewusst, statt anzuhaengen: vfs-vf-koerper hat beim Bau
;; bereits den Segmentwert gesammelt, der hier nicht gelten soll. Ergebnis ist
;; genau ein Eintrag.
;;
;; Gerechnet wird aus der GEBAUTEN Geometrie, nicht aus der Soll-Vorgabe
;; (anders als MONTAGEHOEHE_m, dessen hoehe-bis aus deltaH abgeleitet ist).
;; Beide Hoehen in mm.
(defun vf-vfhoehe-kette (z-anfang z-ende)
(if (and (numberp z-anfang) (numberp z-ende))
(setq *vf-acc-vfhoehe* (list (vf-meter-3 (/ (+ z-anfang z-ende) 2.0))))
(setq *vf-acc-vfhoehe* '())))
;; Millimeter -> Meter als String mit GENAU 3 Nachkommastellen.
;;
;; (rtos x 2 3) allein genuegt nicht: je nach DIMZIN schneidet es nachfolgende
;; Nullen ab und liefert "2.5" statt "2.500" bzw. "-1" statt "-1.000" (real
;; beobachtet im Testlauf). Fuer eine Merkmalsliste ist die feste Stellenzahl
;; aber gewollt, darum wird hier aufgefuellt - unabhaengig von der
;; Zeichnungseinstellung.
(defun vf-meter-3 (mm / s pos)
(setq s (rtos (/ (float mm) 1000.0) 2 3))
(if (not (vl-string-search "." s)) (setq s (strcat s ".")))
(setq pos (vl-string-search "." s))
(while (< (- (strlen s) pos 1) 3) (setq s (strcat s "0")))
s)
;; ============================================================
;; TEIL 5: KS_EIN/KS_AUS EXTRAKTION
;; ============================================================
@@ -977,6 +1073,9 @@
(cons "L_VF_m" (rtos (/ L_VF 1000.0) 2 3))
(cons "ANTRIEBFAHRTRICHTUNG" richtung)
(cons "VF_WINKEL" (itoa best-winkel))
;; Hoehe der (einen) Foerdereinheit - beim Standard-/Etage-Typ
;; fuellen vfs-vf-entry/-exit genau einen Listeneintrag.
(cons "VF_HOEHE_m" (vfl-join-komma *vf-acc-vfhoehe*))
(cons "ANZAHL_SEPARATOR" "2")
(cons "ANZAHL_SCANNER" (itoa n-scanner))
(cons "GERUEST_EINZELMODUL" geruest-einzelmodul)
@@ -1013,6 +1112,10 @@
horizontal-info winkelwahl best-winkel L_GF L_VF L_GF1 L_GF2
verteilung-modus n-scanner hoehe-von hoehe-bis lastEnt
vf-insert vf-endpunkt staustrecke-basis)
;; VF-Hoehen-Akkumulator pro Anlage zuruecksetzen - sonst erbte die naechste
;; Anlage die Hoehen der vorherigen. (Im Linienzug erledigt das
;; vfl-acc-reset; Standard/Etage laufen nicht darueber.)
(vf-vfhoehe-reset)
(setq berechne-fn (vf-registry-berechne-fn typ))
(setq einfuege-fn (vf-registry-einfuege-fn typ))
(setq ergebnis (apply berechne-fn (list deltaL deltaH richtung seite)))
@@ -1064,6 +1167,15 @@
(setq vf-endpunkt
(apply einfuege-fn
(list deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite hz)))
;; VF_HOEHE_m fuer Standard/Etage: Mittelwert ueber die GANZE Kette
;; (AS-KS_EIN = startpunkt, ES-KS_AUS = Rueckgabe der Einfuegefunktion),
;; weil es hier nur einen Motor und nur einen geraden VF-Abschnitt
;; gibt. Ersetzt den beim Bau gesammelten Segmentwert - siehe
;; vf-vfhoehe-kette. Der Linienzug laeuft NICHT hier durch und behaelt
;; daher seine Segmentliste.
(vf-vfhoehe-kette (caddr startpunkt)
(if (and vf-endpunkt (listp vf-endpunkt))
(caddr vf-endpunkt) nil))
(setq vf-insert
(vf-block-erstellen typ seite vf-nummer n-scanner
hoehe-von hoehe-bis deltaH deltaL L_VF L_GF1 L_GF2
Lisp/vf_konstanten.lsp
+11 -4
View File
@@ -101,8 +101,8 @@
(if (null *vfk-etage-hz-winkel*) (setq *vfk-etage-hz-winkel* 30.0))
;; Eckwinkel-Toleranz bei der automatischen Pfad-Klassifizierung (Modus 3,
;; vf-linienzug-modus3 -> vfl2-pruefe-eckwinkel). Aktiv referenziert in
;; vf_linienzug.lsp (beide Aufrufstellen von vfl2-pruefe-eckwinkel).
;; vf-linienzug-modus3 -> vfl-pfad-eckwinkel-pruefen). Aktiv referenziert in
;; vf_linienzug.lsp (beide Aufrufstellen von vfl-pfad-eckwinkel-pruefen).
(if (null *vfk-eckwinkel-toleranz*) (setq *vfk-eckwinkel-toleranz* 5.0))
;; Schwellwert (Grad), ab dem ein Frame noch als "flach" (~0 Grad) gilt.
@@ -123,7 +123,7 @@
;; (vf_etage.lsp Z.41)
;; - Linienzug-Kettenende/Body-Abschluss (nur Motor+1 Separator, KEIN
;; Umlenk-Anteil): 800 als rohes Literal an >10 Stellen in
;; vf_linienzug.lsp (vfl-body-zerlegung, vfl3-waehle-winkel, ...)
;; vf_linienzug.lsp (vfl-body-zerlegung, vfl-zsolve-winkel-waehlen, ...)
;; Diese vier NICHT vereinheitlichen ohne sorgfaeltige Pruefung - sie
;; entstehen aus unterschiedlicher Bauteil-Zusammensetzung (siehe jeweiliger
;; Kommentar im Modul), keine Kopiergleichheit.
@@ -166,7 +166,7 @@
;; Mindestlaenge (mm) fuer die 3-Grad-GF-Anschlussstrecke (GF1 am Einlauf
;; einer VF-Einheit). Bereits als *vfl-gf-min-laenge* in vf_linienzug.lsp
;; benannt (Wert 400.0) - hier nur gespiegelt. Das fruehere rohe 400.0-
;; Duplikat (br-gf1 in vfl3-*) referenziert jetzt *vfl-gf-min-laenge*.
;; Duplikat (br-gf1 in vfl-zsolve-*) referenziert jetzt *vfl-gf-min-laenge*.
(if (null *vfk-gf-anschluss-mindestlaenge*) (setq *vfk-gf-anschluss-mindestlaenge* 400.0))
;; ============================================================
@@ -303,6 +303,13 @@
;; Ueberschreiten, kein Abbruch. Aktiv referenziert.
(if (null *vfk-vf-laenge-max*) (setq *vfk-vf-laenge-max* 25000.0))
;; Hoechstzahl Vario-Kurven INNERHALB einer VF-Einheit (zwischen Umlenk- und
;; Motorstation) - Nutzer-Regel 2026-10-22. Zwei Kurven bedeuten hoechstens
;; drei VF-Geraden im selben Lauf; danach muss die Einheit mit einer
;; Motorstation schliessen und eine neue mit Umlenkstation beginnen.
;; Geprueft in vfl-m2-lauf-grenzen (vf_linienzug.lsp, Modus 2).
(if (null *vfk-vf-kurven-max*) (setq *vfk-vf-kurven-max* 2))
(setq *vfk-konstanten-geladen* t)
(princ)
(princ)
Lisp/vf_linienzug.lsp
+2479 -252
View File
File diff suppressed because it is too large Load Diff
Lisp/vf_spec.lsp
+47 -4
View File
@@ -274,7 +274,18 @@
((and (= (type v) 'STR) (= (strcase v) "AUTO")) (vsp-raus "NIL" nil))
(T (vsp-zahl "REAL" v "eingang_hoehe"))))
(defun vsp-praeambel (kopf / punkt)
;; Praeambel-Tokens: PT(Startpunkt) REAL(Starthoehe) STR(AS ja/nein)
;; [STR(Winkel) STR(Seite) (PT|NIL)(Zufuehrungsachse)].
;;
;; Das Achsen-Feld "as_achse" ist OPTIONAL (Gegenstueck zu
;; vfl-frage-as-winkel-seite-oder-achse und zu praeambel() in
;; lib/vf_linienzug_grammatik.py):
;; [x, y, z] -> PT (Zufuehrungsachse ueber einen zweiten Punkt)
;; "ohne" -> NIL (bewusst ohne Achse gebaut)
;; fehlt -> gar kein Token = Journalformat VOR 2026-10-21. Das replayt
;; unveraendert; die Kettenrichtung kommt dann wie frueher aus
;; dem naechsten Klick.
(defun vsp-praeambel (kopf / punkt achse)
(setq *vsp-wo* "start")
(setq punkt (ssg-val kopf "start_punkt"))
(if (and punkt (listp punkt) (>= (length punkt) 3))
@@ -287,7 +298,13 @@
(if (vsp-ja-p (ssg-val kopf "as"))
(progn
(vsp-wert-str (ssg-val kopf "as_winkel") "as_winkel")
(vsp-code-raus *vsp-tab-seite* (ssg-val kopf "as_seite") "as_seite"))))
(vsp-code-raus *vsp-tab-seite* (ssg-val kopf "as_seite") "as_seite")
(setq achse (ssg-val kopf "as_achse"))
(cond
((and achse (listp achse) (>= (length achse) 3))
(vsp-raus "PT" (mapcar 'float achse)))
((equal achse "ohne") (vsp-raus "NIL" nil))
))))
;; naechste: Felder der NAECHSTEN Top-Level-Sektion (oder nil) - wird nur fuer
;; "Linie-GF" gebraucht (siehe dort). *vsp-es-verbraucht* (Ausgabe-Flag, vom
@@ -664,6 +681,7 @@
(setq *vsp-alt-headless* (if (boundp '*vfl-headless*) *vfl-headless*))
(setq *vfl-wizard-mode* nil)
(setq *vfl-headless* T)
(setq *vsp-alt-gui* (if (boundp '*ssg-gui-aus*) *ssg-gui-aus*))
(if (car (atoms-family 1 '("SSG-GUI-AUS"))) (ssg-gui-aus))
(setq *vsp-prompts* 0)
(princ))
@@ -676,7 +694,9 @@
alert *vsp-alt-alert*)
(setq *vfl-wizard-mode* *vsp-alt-wizard*)
(setq *vfl-headless* *vsp-alt-headless*)
(if (car (atoms-family 1 '("SSG-GUI-AN"))) (ssg-gui-an))
;; Vorzustand zurueck statt pauschal ssg-gui-an: unter SSG_RUN_ALL_TESTS
;; muss die GUI fuer den Export danach aus bleiben.
(setq *ssg-gui-aus* *vsp-alt-gui*)
(princ))
@@ -919,6 +939,29 @@
;; sid = Kennung im Record, dim = "2D"/"3D" oder nil (Sitzung),
;; fehler = Liste der Spec-Fehler (bei nil-Journal die Begruendung).
;; Erwartet den Headless-Rahmen (vsp-headless-an) beim Aufrufer.
;; Bau-Funktion AUS DEM JOURNAL ableiten (Rueckgabe: Funktions-Symbol).
;; Bewusst abgeleitet statt als zusaetzliches Argument: vsp-bau-journal hat
;; zwei Aufrufer, und AutoLISP verlangt exakte Argumentzahl - eine erweiterte
;; Signatur muesste jeden davon nachziehen (siehe CLAUDE.md). Die Ableitung
;; kann der Datenlage ausserdem nicht widersprechen, weil sie GENAU das
;; Journal liest, das gleich abgespielt wird.
;;
;; Unterscheidung:
;; kein SEGS -> Modus 1 (Fragenfluss, Menue-Codes)
;; SEGS + STR "m2v2" -> Modus 2 (die Formatmarke schreibt nur
;; vf-linienzug-modus2, vfl-m2-formatmarke)
;; SEGS ohne "m2v2" -> Modus 3
;; Ein Fehlgriff faellt sofort auf: der Ergebnis-Record meldet dann offene
;; Eingaben bzw. glieder_soll <> glieder_ist.
(defun vsp-bau-fn-fuer-journal (journal)
(cond
((not (vfl-journal-hat-segs-p journal)) 'vf-linienzug-modus)
((vl-some (function (lambda (e)
(and (equal (car e) "STR") (equal (cdr e) "m2v2"))))
journal)
'vf-linienzug-modus2)
(t 'vf-linienzug-modus3)))
(defun vsp-bau-journal (sid journal dim fehler / rec vor-ent alt-error err
offen hl meld ist-glieder soll-glieder diff
ist-journal jdiff ent ed)
@@ -958,7 +1001,7 @@
(setq alt-error *error*)
(vfl-journal-reset)
(vfl-journal-replay-start journal)
(setq err (vl-catch-all-apply 'vf-linienzug-modus '()))
(setq err (vl-catch-all-apply (vsp-bau-fn-fuer-journal journal) '()))
(setq offen (vsp-queue-rest))
;; Diagnose VOR dem Reset sichern (vfl-journal-reset loescht sie).
(setq ist-journal (reverse *vfl-journal*))
Lisp/vf_standard.lsp
+22 -2
View File
@@ -609,12 +609,30 @@
;; EIN reines VF-Sub-Segment. Wichtig: es BEGINNT und ENDET auf der
;; 3-Grad-Basisneigung, weil Ein- und Ausgangsbogen denselben Winkel haben.
;; Dadurch lassen sich mehrere Sub-Segmente (und Vario-Kurven dazwischen)
;; beliebig aneinanderreihen (siehe doc/VarioFoerderer_Linienzug_Prinzipien.md).
;; beliebig aneinanderreihen.
;;
;; Die Regel dahinter: der Vertikalbogen am ENDE eines VF (vor der
;; Motorstation) hat denselben Winkel wie der am ANFANG (nach der
;; Umlenkstation), und der abschliessende Bogen bringt die Strecke auf 3 Grad
;; NACH UNTEN - weil die Motorstation selbst mit 3 Grad geneigt eingebaut wird
;; und der Anschluss sonst knickt. Dasselbe gilt am anderen Ende: Umlenkstation
;; (VF-Start) und Separator+ES-Element (Kettenende) gibt es hardwareseitig nur
;; fuer die Anfahrt auf dieser Standard-Fallend-Basis; eine Anfahrt auf
;; STEIGENDER Basis ist physisch nicht vorgesehen.
;; Anfang und Ende auf derselben Basis zu halten ist also keine Konvention,
;; sondern die Voraussetzung dafuer, dass zwei Sub-Segmente ueberhaupt
;; aneinanderpassen.
;; best-winkel=0 => horizontales Sub-Segment (Boegen fest auf_3/ab_3).
(defun vfs-vf-koerper (aktueller-punkt richtung best-winkel L_VF hz /
bogen-name bogen-mass bogen-dx bogen-dz)
bogen-name bogen-mass bogen-dx bogen-dz z-ein)
(if (null hz) (setq hz 0.0))
(setq hz (float hz))
;; Hoehe DIESES VF-Segments (Attribut VF_HOEHE_m, Sivas 4433-4437):
;; KS_EIN ist der Punkt beim Eintritt, KS_AUS der Rueckgabewert am Ende -
;; der Mittelwert beider wird unten angehaengt. Eine Kette mit drei durch
;; Vario-Boegen getrennten Abschnitten bekommt dadurch drei Werte, parallel
;; zu L_VF_m und VF_WINKEL (Nutzer-Vorgabe 2026-10-21).
(setq z-ein (caddr aktueller-punkt))
;; 5. 1. Vertikalbogen
;; Sonderfall best-winkel=0 (horizontale Zwischenstrecke, siehe
@@ -717,6 +735,8 @@
)
)
;; Segment-Hoehe anhaengen: Mittelwert aus KS_EIN (z-ein) und KS_AUS.
(vf-vfhoehe-segment z-ein (caddr aktueller-punkt))
aktueller-punkt
)