Michael StanglandClaude Sonnet 5
f751a90076
Bisher tauchten nur der Wrapper selbst, verpackte Separatoren und AS/ES- Kettenenden als eigene CSV-Zeilen auf - die uebrigen Kettenbausteine (Boegen, gerade Foerderer-/Gefaellestrecken-Segmente, Umlenk-/Motorstation) blieben nur in der Wrapper-Blockdefinition verpackt. csv:element-proxies- erzeugen (analog zu csv:sep-proxies-erzeugen) fuegt fuer jeden Fund eine temporaere Kopie ein, K1/K2 kommen aus dem EIGENEN KS_EIN/KS_AUS jedes Elements (nicht dem Gesamt-AS/ES der Kette) und bleiben leer, wo keines existiert (z.B. das nie tatsaechlich eingefuegte Vario_Kurve_*). Zusaetzlicher Fix: csv:get-k-kos-strings ignorierte bisher die Skalierung des Top-Level-Inserts - fuer Staustrecke_SP_1000_mm (das per Laenge nicht- uniform skaliert wird) waere K2 damit falsch gewesen, unabhaengig von der tatsaechlich gebauten Segmentlaenge. Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
330 lines
14 KiB
Common Lisp
330 lines
14 KiB
Common Lisp
;; ============================================================
|
|
;; SSG_ID - Eindeutige ID-Verwaltung fuer SSG_LIB Bloecke
|
|
;;
|
|
;; Jedes eingefuegte Element erhaelt ein Attribut "ID" mit
|
|
;; einer eindeutigen, vierstelligen Nummer (z.B. "0001").
|
|
;;
|
|
;; Befehle:
|
|
;; IDGENERATE - Weist dem zuletzt eingefuegten Block eine neue ID zu
|
|
;; IDSCHECK - Prueft alle Bloecke auf doppelte IDs und korrigiert sie
|
|
;;
|
|
;; Funktionen:
|
|
;; (ssg-id-max) - Hoechste ID in der Zeichnung ermitteln
|
|
;; (ssg-id-generate ent) - Neue ID erzeugen und auf Block setzen
|
|
;; (ssg-id-check-all) - Doubletten pruefen und korrigieren
|
|
;; (ssg-id-format n) - Zahl als 4-stelligen String formatieren
|
|
;; ============================================================
|
|
|
|
|
|
;; --- ID als 4-stelligen String formatieren ---
|
|
;; n = Integer (z.B. 1 -> "0001", 42 -> "0042")
|
|
(defun ssg-id-format (n / s)
|
|
(setq s (itoa n))
|
|
(while (< (strlen s) 4)
|
|
(setq s (strcat "0" s))
|
|
)
|
|
s
|
|
)
|
|
|
|
|
|
;; --- Alle exportierbaren INSERT-Entities sammeln ---
|
|
;; Gleiche Filterlogik wie csv:collect-export-blocks (siehe dort auch
|
|
;; pattern_separator/pattern_scanner in cfg/export.cfg - Separator_SP/S-LP/
|
|
;; Scanner sind eigenstaendige Sensor-Bloecke, die inzwischen ein eigenes
|
|
;; ID-ATTDEF haben und daher hier ebenfalls erfasst werden muessen, sonst
|
|
;; bleibt ihr ID-Attribut trotz ATTDEF für immer leer - ssg-attrib-set-on
|
|
;; kann nur einen Wert SETZEN, wenn der Block ueberhaupt erst hier landet).
|
|
;; BTMT-Beladung*/SC_Entladung* (siehe pattern_btmt_beladung/
|
|
;; pattern_btmt_entladung in cfg/export.cfg) aus demselben Grund: sonst bleibt
|
|
;; ihre ID trotz ATTDEF leer und sie fehlen bei der zeichnungsweiten Duplikat-
|
|
;; pruefung/Maximum-Ermittlung (ssg-id-check-all).
|
|
;; Eingang*/Ausgang* (Materialfluss-Ein-/Ausgangssymbole, siehe
|
|
;; pattern_eingang/pattern_ausgang in cfg/export.cfg) ebenso: die DWGs haben
|
|
;; seit dem ID-Nachtrag (allocations.json) ein leeres ID-ATTDEF, das hier
|
|
;; gefuellt werden muss, damit sie eine stabile TeileId fuer die "TrackIds"-
|
|
;; Spalte (auch auf Kreiseln) bekommen.
|
|
;; GR_* (Geruest-Baugruppen, siehe pattern_geruest in cfg/export.cfg) ebenso -
|
|
;; das ID-ATTDEF steht seit *geruest-attrib-defs* zur Verfuegung.
|
|
;; 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_*-
|
|
;; Bausteine (csv:element-proxies-erzeugen, export.lsp) - anders als diese
|
|
;; faengt "Gefaellebogen" aber KEINES der obigen Praefixe ab und braucht
|
|
;; daher eine eigene Klausel.
|
|
(defun ssg-id-collect-blocks ( / ss-all ss-out i ename ed bname)
|
|
(dbgf "ssg-id-collect-blocks")
|
|
(setq ss-all (ssget "X" (list (cons 0 "INSERT"))))
|
|
(dbgreturn (if (null ss-all)
|
|
nil
|
|
(progn
|
|
(setq ss-out (ssadd))
|
|
(setq i 0)
|
|
(while (setq ename (ssname ss-all i))
|
|
(setq ed (entget ename))
|
|
(setq bname (cdr (assoc 2 ed)))
|
|
(if (or
|
|
(wcmatch bname "KR_*,KREISEL_*,ECKRAD_*")
|
|
(wcmatch (strcase bname) "AP110*,AP_110*,AP60*,AP_60*,APG110*")
|
|
(wcmatch bname "Vario*,Staustrecke*,Gefaellebogen*,AUS_Element*,EIN_Element*,VF_*,GF_*")
|
|
;; ZZ_ASES_MARKER: die Marker der AS-/ES-Kettenenden (siehe
|
|
;; csv:asmark-aktualisieren, export.lsp). Sie brauchen eine ID -
|
|
;; sie vertreten das Kettenende im Export ("sepliste"-Feld "id"
|
|
;; und eigene JSON-Zeile) und behalten sie ueber Laeufe hinweg,
|
|
;; weil der Marker in der Zeichnung stehen bleibt.
|
|
(wcmatch bname "ZZ_ASES_MARKER*")
|
|
(wcmatch bname "Separator_SP*,S-LP*,Scanner*")
|
|
(wcmatch bname "BTMT-Beladung*,SC_Entladung*")
|
|
(wcmatch bname "Eingang*,Ausgang*")
|
|
(wcmatch bname "GR_*")
|
|
(wcmatch bname "#*")
|
|
)
|
|
(ssadd ename ss-out)
|
|
)
|
|
(setq i (1+ i))
|
|
)
|
|
(if (= (sslength ss-out) 0) nil ss-out)
|
|
)
|
|
))
|
|
)
|
|
|
|
|
|
;; --- Hoechste bereits vergebene ID in einem Auswahlsatz ermitteln ---
|
|
;; ss = Auswahlsatz (i.d.R. aus ssg-id-collect-blocks) oder nil.
|
|
;; Rueckgabe: Integer (hoechste ID) oder 0 wenn keine gefunden.
|
|
;;
|
|
;; Bewusst als eigene Funktion: ssg-id-check-all MUSS diesen Wert ueber den
|
|
;; GESAMTEN Auswahlsatz kennen, BEVOR es die erste neue ID vergibt (siehe
|
|
;; Phase 0 dort) - sonst haengt die Neuvergabe von der (beliebigen)
|
|
;; ssget-Reihenfolge ab und vergibt IDs, die weiter hinten im Auswahlsatz
|
|
;; schon belegt sind.
|
|
(defun ssg-id-max-in-ss (ss / i ename attribs id-val id-num max-id)
|
|
(setq max-id 0)
|
|
(if ss
|
|
(progn
|
|
(setq i 0)
|
|
(while (setq ename (ssname ss i))
|
|
(setq attribs (ssg-attrib-read ename))
|
|
(setq id-val (cdr (assoc "ID" attribs)))
|
|
(if (and id-val (> (strlen id-val) 0))
|
|
(progn
|
|
(setq id-num (atoi id-val))
|
|
(if (> id-num max-id)
|
|
(setq max-id id-num)
|
|
)
|
|
)
|
|
)
|
|
(setq i (1+ i))
|
|
)
|
|
)
|
|
)
|
|
max-id
|
|
)
|
|
|
|
|
|
;; --- Hoechste ID in der Zeichnung ermitteln ---
|
|
;; Durchsucht alle exportierbaren Bloecke nach dem Attribut "ID".
|
|
;; Rueckgabe: Integer (hoechste ID) oder 0 wenn keine gefunden.
|
|
(defun ssg-id-max ( / max-id)
|
|
(dbgf "ssg-id-max")
|
|
(setq max-id (ssg-id-max-in-ss (ssg-id-collect-blocks)))
|
|
(dbgreturn max-id)
|
|
)
|
|
|
|
|
|
;; --- Neue ID erzeugen und auf einen Block setzen ---
|
|
;; ent = Entity-Name eines INSERT-Blocks mit ID-Attribut
|
|
;; Rueckgabe: Die zugewiesene ID als String oder nil bei Fehler
|
|
(defun ssg-id-generate (ent / max-id new-id new-id-str)
|
|
(dbgf "ssg-id-generate")
|
|
(dbg 'ent)
|
|
(dbgreturn (if (and ent (= (cdr (assoc 0 (entget ent))) "INSERT"))
|
|
(progn
|
|
(setq max-id (ssg-id-max))
|
|
(setq new-id (1+ max-id))
|
|
(setq new-id-str (ssg-id-format new-id))
|
|
(ssg-attrib-set-on ent (list (cons "ID" new-id-str)))
|
|
(princ (ssg-textf "id-new-assigned" (list new-id-str)))
|
|
new-id-str
|
|
)
|
|
(progn
|
|
(princ (ssg-text "id-invalid-block"))
|
|
nil
|
|
)
|
|
))
|
|
)
|
|
|
|
|
|
;; --- ID-Attribut setzen UND sofort verifizieren ---
|
|
;; ssg-attrib-set-on kann eine Tag/Wert-Zuweisung STILL VERWERFEN, wenn der
|
|
;; INSTANZ-spezifische ATTRIB-Eintrag fuer diesen Tag gar nicht existiert
|
|
;; (z.B. bei einer Blockreferenz, die vor dem Hinzufuegen des ID-ATTDEF
|
|
;; eingefuegt wurde und seither nicht per ATTSYNC aktualisiert wurde) -
|
|
;; ohne Fehlermeldung. Das fuehrt genau zu der Art von "unsichtbarem"
|
|
;; doppelten ID-Fehler, der ssg-id-check-all eigentlich verhindern soll:
|
|
;; die Funktion GLAUBT, sie habe eine neue ID vergeben, aber am Block
|
|
;; steht weiterhin die alte (bzw. gar keine) ID. Diese Hilfsfunktion liest
|
|
;; nach dem Setzen sofort zurueck und warnt laut, wenn es nicht geklappt hat.
|
|
(defun ssg-id-set-and-verify (ename new-id-str kontext-text / attribs-danach)
|
|
(dbgf "ssg-id-set-and-verify")
|
|
(dbg 'ename)
|
|
(dbg 'new-id-str)
|
|
(dbg 'kontext-text)
|
|
(ssg-attrib-set-on ename (list (cons "ID" new-id-str)))
|
|
(setq attribs-danach (ssg-attrib-read ename))
|
|
(dbgreturn (if (not (equal (cdr (assoc "ID" attribs-danach)) new-id-str))
|
|
(princ (strcat "\n[SSG_ID] WARNUNG: ID=" new-id-str " konnte NICHT auf "
|
|
(cdr (assoc 2 (entget ename))) " (Handle "
|
|
(cdr (assoc 5 (entget ename))) ", " kontext-text
|
|
") geschrieben werden - Block hat vermutlich kein "
|
|
"ID-ATTDEF (Attribut-Sync/Redefine noetig)."))
|
|
))
|
|
)
|
|
|
|
;; --- Alle Bloecke auf doppelte IDs pruefen und korrigieren ---
|
|
;; Findet Bloecke mit gleicher ID. Behaelt die erste Instanz,
|
|
;; weist Duplikaten neue IDs zu.
|
|
;; Rueckgabe: Anzahl korrigierter IDs
|
|
(defun ssg-id-check-all ( / ss i ename attribs id-val id-num
|
|
id-map entry max-id fixed-count new-id-str bname)
|
|
(dbgf "ssg-id-check-all")
|
|
(setq ss (ssg-id-collect-blocks))
|
|
(dbg 'ss)
|
|
(dbgp (strcat "Anzahl erfasster Bloecke: " (if ss (itoa (sslength ss)) "0")))
|
|
(dbgreturn (if (null ss)
|
|
(progn
|
|
(princ (ssg-text "id-check-no-blocks"))
|
|
0
|
|
)
|
|
(progn
|
|
;; Phase 0: Hoechste BEREITS vergebene ID ueber den GESAMTEN Auswahlsatz
|
|
;; ermitteln - zwingend VOR der ersten Neuvergabe in Phase 1.
|
|
;;
|
|
;; Frueher wurde max-id erst waehrend Phase 1 mitgefuehrt (Start 0) und
|
|
;; eine fehlende ID sofort mit max-id+1 belegt. Die Reihenfolge von
|
|
;; (ssget "X" ...) ist aber beliebig - in BricsCAD kommen die zuletzt
|
|
;; erzeugten Entities zuerst. Genau das trifft die temporaeren
|
|
;; Separator-Kopien aus csv:sep-proxies-erzeugen (export.lsp): sie haben
|
|
;; noch keine ID, stehen ganz vorne und bekamen daher 0001, 0002, ... -
|
|
;; also exakt die IDs, die die weiter hinten liegenden Kreisel/VF_n/GF_n
|
|
;; laengst tragen. Phase 2 konnte das nicht heilen, weil die frisch
|
|
;; vergebenen IDs nicht in id-map landen (und auch nicht muessen: sie
|
|
;; liegen jetzt garantiert oberhalb jeder vorhandenen ID).
|
|
(dbgp "=== Phase 0: hoechste vorhandene ID ermitteln ===")
|
|
(setq max-id (ssg-id-max-in-ss ss))
|
|
(dbgp (strcat "Phase 0: hoechste vorhandene ID = " (itoa max-id)))
|
|
|
|
;; Phase 1: Alle IDs sammeln, Bloecke ohne ID neu nummerieren
|
|
(dbgp "=== Phase 1: IDs sammeln ===")
|
|
(setq id-map nil)
|
|
(setq i 0)
|
|
(while (setq ename (ssname ss i))
|
|
(setq attribs (ssg-attrib-read ename))
|
|
(setq id-val (cdr (assoc "ID" attribs)))
|
|
(setq bname (cdr (assoc 2 (entget ename))))
|
|
(dbgp (strcat " [" (itoa i) "] " bname " (Handle " (cdr (assoc 5 (entget ename)))
|
|
") ID-Attrib-vorhanden=" (if (assoc "ID" attribs) "JA" "NEIN")
|
|
" id-val=" (if id-val (strcat "\"" id-val "\"") "nil")))
|
|
(if (and id-val (> (strlen id-val) 0))
|
|
(progn
|
|
(setq id-num (atoi id-val))
|
|
;; max-id NICHT mehr hier nachziehen - es steht seit Phase 0 auf
|
|
;; dem globalen Maximum und dient ab jetzt nur noch als Zaehler
|
|
;; fuer die Neuvergabe.
|
|
;; In Map eintragen: (id-num . (ename1 ename2 ...))
|
|
(setq entry (assoc id-num id-map))
|
|
(if entry
|
|
(progn
|
|
(dbgp (strcat " ID " id-val " bereits gesehen bei "
|
|
(itoa (length (cdr entry))) " anderen Block(en) -> DUPLIKAT-KANDIDAT"))
|
|
(setq id-map (subst (cons id-num (append (cdr entry) (list ename)))
|
|
entry id-map))
|
|
)
|
|
(setq id-map (cons (cons id-num (list ename)) id-map))
|
|
)
|
|
)
|
|
;; Block ohne ID -> neue ID zuweisen
|
|
(progn
|
|
(setq max-id (1+ max-id))
|
|
(setq new-id-str (ssg-id-format max-id))
|
|
(dbgp (strcat " -> keine/leere ID, weise neu zu: " new-id-str))
|
|
(ssg-id-set-and-verify ename new-id-str "Block ohne ID")
|
|
(princ (ssg-textf "id-check-missing-set"
|
|
(list new-id-str (cdr (assoc 2 (entget ename))))))
|
|
)
|
|
)
|
|
(setq i (1+ i))
|
|
)
|
|
(dbgp (strcat "Phase 1 abgeschlossen: max-id=" (itoa max-id)
|
|
" id-map hat " (itoa (length id-map)) " unterschiedliche ID-Werte"))
|
|
(foreach entry id-map
|
|
(if (> (length (cdr entry)) 1)
|
|
(dbgp (strcat " DUPLIKAT ID=" (ssg-id-format (car entry)) ": "
|
|
(itoa (length (cdr entry))) " Bloecke -> "
|
|
(apply 'strcat (mapcar
|
|
'(lambda (e) (strcat (cdr (assoc 2 (entget e))) "(Handle "
|
|
(cdr (assoc 5 (entget e))) ") "))
|
|
(cdr entry)))))
|
|
)
|
|
)
|
|
|
|
;; Phase 2: Duplikate korrigieren
|
|
(dbgp "=== Phase 2: Duplikate korrigieren ===")
|
|
(setq fixed-count 0)
|
|
(foreach entry id-map
|
|
(if (> (length (cdr entry)) 1)
|
|
(progn
|
|
;; Erste Instanz behalten, Duplikate neu nummerieren
|
|
(dbgp (strcat "ID=" (ssg-id-format (car entry)) ": behalte "
|
|
(cdr (assoc 2 (entget (car (cdr entry))))) " (Handle "
|
|
(cdr (assoc 5 (entget (car (cdr entry))))) "), nummeriere "
|
|
(itoa (1- (length (cdr entry)))) " weitere um"))
|
|
(foreach ename (cdr (cdr entry))
|
|
(setq max-id (1+ max-id))
|
|
(setq new-id-str (ssg-id-format max-id))
|
|
(dbgp (strcat " " (cdr (assoc 2 (entget ename))) " (Handle "
|
|
(cdr (assoc 5 (entget ename))) ") ID=" (ssg-id-format (car entry))
|
|
" -> " new-id-str))
|
|
(ssg-id-set-and-verify ename new-id-str
|
|
(strcat "Duplikat von ID=" (ssg-id-format (car entry))))
|
|
(princ (ssg-textf "id-check-duplicate"
|
|
(list (ssg-id-format (car entry)) new-id-str
|
|
(cdr (assoc 2 (entget ename))))))
|
|
(setq fixed-count (1+ fixed-count))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(dbgp (strcat "Phase 2 abgeschlossen: " (itoa fixed-count) " Duplikate korrigiert"))
|
|
|
|
(princ (ssg-textf "id-check-done" (list fixed-count)))
|
|
fixed-count
|
|
)
|
|
))
|
|
)
|
|
|
|
|
|
;; --- Befehl: IDSCHECK ---
|
|
;; Prueft alle Bloecke auf doppelte IDs und korrigiert sie.
|
|
(defun c:IDSCHECK ( / count)
|
|
(ssg-start "IDSCHECK" nil)
|
|
(setq count (ssg-id-check-all))
|
|
(princ (ssg-textf "id-check-corrected" (list count)))
|
|
(ssg-end)
|
|
(princ)
|
|
)
|
|
|
|
;; --- Befehl: IDGENERATE ---
|
|
;; Fordert den Benutzer auf, einen Block zu waehlen und weist eine neue ID zu.
|
|
(defun c:IDGENERATE ( / ent ed)
|
|
(ssg-start "IDGENERATE" nil)
|
|
(setq ent (car (entsel (ssg-text "id-select-block-prompt"))))
|
|
(if (and ent (= (cdr (assoc 0 (entget ent))) "INSERT"))
|
|
(ssg-id-generate ent)
|
|
(princ (ssg-text "id-generate-invalid"))
|
|
)
|
|
(ssg-end)
|
|
(princ)
|
|
)
|
|
|
|
(princ)
|