From 41311f5fd3abd856d2e00389b1abc721e2d26d90 Mon Sep 17 00:00:00 2001 From: Yuelin Wang Date: Mon, 20 Jul 2026 18:14:06 +0200 Subject: [PATCH] ZAEHLE_SEP_SCAN schreibt ILS-Bezeichnung in Sensor-Attribut zuordnung und markiert nicht zugeordnete Sensoren mit Gelb Kreis --- Lisp/count_sep_scan.lsp | 210 +++++++++++++++++++++++++++++++++------- 1 file changed, 173 insertions(+), 37 deletions(-) diff --git a/Lisp/count_sep_scan.lsp b/Lisp/count_sep_scan.lsp index f2e0d8c..b5d3b03 100644 --- a/Lisp/count_sep_scan.lsp +++ b/Lisp/count_sep_scan.lsp @@ -19,6 +19,15 @@ ;;; - Ein optionaler Toleranzrand (*senstol*) vergroessert die ;;; Box, damit Sensoren knapp am Rand noch erfasst werden. ;;; +;;; Zusaetzlich: +;;; - Bei zugeordneten Sensoren wird die Bezeichnung des ILS-Blocks +;;; (Attribut "Bezeichnung", Fallback Blockname) in das Sensor- +;;; Attribut *zuordnung-tag* geschrieben. +;;; - Nicht zugeordnete Sensoren werden mit einem Kreis auf dem +;;; Layer *mark-layer* markiert (zentriert auf den Sensor). +;;; - Der Befehl ist wiederholbar: alte Markierungskreise werden +;;; zu Beginn entfernt. +;;; ;;; Aufruf: ZAEHLE_SEP_SCAN ;;; Laden: per APPLOAD oder (load "count_sep_scan") ;;; ============================================================ @@ -44,6 +53,18 @@ ;; ANZAHL_SEPARATOR und werden bei jedem Lauf frisch gezaehlt. (setq *intern-separator-pattern* "STAUSTRECKE_SEPARATOR_SP*") +;; Attribut-Tag im Scanner-/Separator-Block, in das die Bezeichnung +;; des zugeordneten ILS-Blocks geschrieben wird (Gross/Klein egal). +(setq *zuordnung-tag* "zuordnung") + +;; Markierung nicht zugeordneter Sensoren: Kreis auf eigenem Layer. +(setq *mark-layer* "S_SENSOR_UNZUGEORDNET") +(setq *mark-color* 2) ;; 2 = Gelb +;; Kreisradius = Faktor * halbe XY-Diagonale der Sensor-Box, +;; mindestens *mark-radius-min* (mm). +(if (null *mark-radius-factor*) (setq *mark-radius-factor* 1.5)) +(if (null *mark-radius-min*) (setq *mark-radius-min* 500.0)) + ;;; ------------------------------------------------------------ ;;; ILS-Block-Erkennung und zugehoerige Attribut-Tags ;;; Alle ILS-Bloecke (Kreisel / VF / GF) verwenden einheitlich @@ -185,19 +206,26 @@ ;;; Rueckgabe: T wenn Tag gefunden und gesetzt, sonst nil. ;;; ------------------------------------------------------------ (defun cs-set-att (ins tag val / e ed done ok) - (setq e (entnext ins) done nil ok nil) - (while (and e (not done)) - (setq ed (entget e)) - (cond - ((= (cdr (assoc 0 ed)) "ATTRIB") - (if (= (strcase (cdr (assoc 2 ed))) (strcase tag)) - (progn - (entmod (subst (cons 1 val) (assoc 1 ed) ed)) - (entupd e) - (setq ok t)))) - ((= (cdr (assoc 0 ed)) "SEQEND") (setq done t)) + (setq done nil ok nil) + ;; Nur iterieren, wenn der INSERT ueberhaupt Attribute fuehrt (66=1), + ;; sonst wuerde entnext in fremde Objekte weiterlaufen. + (if (= (cdr (assoc 66 (entget ins))) 1) + (progn + (setq e (entnext ins)) + (while (and e (not done)) + (setq ed (entget e)) + (cond + ((= (cdr (assoc 0 ed)) "ATTRIB") + (if (= (strcase (cdr (assoc 2 ed))) (strcase tag)) + (progn + (entmod (subst (cons 1 val) (assoc 1 ed) ed)) + (entupd e) + (setq ok t)))) + ((= (cdr (assoc 0 ed)) "SEQEND") (setq done t)) + ) + (setq e (entnext e)) + ) ) - (setq e (entnext e)) ) ok ) @@ -231,16 +259,105 @@ n ) +;;; ------------------------------------------------------------ +;;; Attributwert (String) an einem INSERT lesen. "" wenn nicht +;;; vorhanden. Tag ohne Gross/Klein-Unterscheidung. +;;; ------------------------------------------------------------ +(defun cs-get-att-str (ins tag / e ed done val) + (setq done nil val "") + (if (= (cdr (assoc 66 (entget ins))) 1) + (progn + (setq e (entnext ins)) + (while (and e (not done)) + (setq ed (entget e)) + (cond + ((= (cdr (assoc 0 ed)) "ATTRIB") + (if (= (strcase (cdr (assoc 2 ed))) (strcase tag)) + (progn (setq val (cdr (assoc 1 ed))) (setq done t)))) + ((= (cdr (assoc 0 ed)) "SEQEND") (setq done t)) + ) + (setq e (entnext e)) + ) + ) + ) + val +) + +;;; ------------------------------------------------------------ +;;; Bezeichnung eines ILS-Blocks ermitteln: Attribut "Bezeichnung", +;;; Fallback auf den Blocknamen. +;;; ------------------------------------------------------------ +(defun cs-carrier-label (ent nm / bez) + (setq bez (cs-get-att-str ent "Bezeichnung")) + (if (and bez (/= bez "")) bez nm) +) + +;;; ------------------------------------------------------------ +;;; Layer anlegen (falls fehlend), ohne den aktuellen Layer zu aendern. +;;; ------------------------------------------------------------ +(defun cs-ensure-layer (name color / lay ed) + (if (tblsearch "LAYER" name) + ;; Layer existiert bereits: Standardfarbe angleichen + (progn + (setq lay (tblobjname "LAYER" name)) + (setq ed (entget lay)) + (if (assoc 62 ed) + (entmod (subst (cons 62 color) (assoc 62 ed) ed))) + ) + ;; Layer neu anlegen + (entmake (list '(0 . "LAYER") + '(100 . "AcDbSymbolTableRecord") + '(100 . "AcDbLayerTableRecord") + (cons 2 name) + (cons 70 0) + (cons 62 color) + (cons 6 "Continuous"))) + ) +) + +;;; ------------------------------------------------------------ +;;; Nicht zugeordneten Sensor mit einem Kreis markieren, zentriert +;;; auf die Sensor-Geometrie. Radius aus der XY-Box des Sensors +;;; (Faktor), mindestens *mark-radius-min*. +;;; ------------------------------------------------------------ +(defun cs-mark-unassigned (ent / bb ipt cx cy cz r) + (setq bb (cs-bbox ent)) + (setq ipt (cdr (assoc 10 (entget ent)))) + (setq cz (if (and ipt (caddr ipt)) (caddr ipt) 0.0)) + (if bb + (progn + (setq cx (/ (+ (nth 0 bb) (nth 2 bb)) 2.0) + cy (/ (+ (nth 1 bb) (nth 3 bb)) 2.0)) + (setq r (* *mark-radius-factor* + (/ (distance (list (nth 0 bb) (nth 1 bb)) + (list (nth 2 bb) (nth 3 bb))) 2.0))) + (if (< r *mark-radius-min*) (setq r *mark-radius-min*))) + (progn + (setq cx (car ipt) cy (cadr ipt) r *mark-radius-min*)) + ) + (cs-ensure-layer *mark-layer* *mark-color*) + (entmake (list '(0 . "CIRCLE") + (cons 8 *mark-layer*) + (cons 10 (list cx cy cz)) + (cons 40 r))) +) + ;;; ============================================================ ;;; HAUPTBEFEHL ;;; ============================================================ -(defun c:ZAEHLE_SEP_SCAN ( / ss i ent ed nm tags bb cx cy - carriers scanpts seppts kind pt +(defun c:ZAEHLE_SEP_SCAN ( / ss i ent ed nm tags bb cx cy label + carriers scanlist seplist kind pt scanCounts sepCounts rec en nm2 ns nsep internSep newS newP + s sent spt n-scan-unassigned n-sep-unassigned + n-zuordnung-fehlt mss okS okP) - (setq carriers nil scanpts nil seppts nil) + (setq carriers nil scanlist nil seplist nil n-zuordnung-fehlt 0) + + ;; Alte Markierungskreise entfernen (Idempotenz) + (setq mss (ssget "_X" (list (cons 0 "CIRCLE") (cons 8 *mark-layer*)))) + (if mss (command "_.ERASE" mss "")) ;; Vor der Extents-Berechnung einmal regenerieren, damit ;; vla-getboundingbox verlaessliche Werte liefert. @@ -265,47 +382,62 @@ (progn (setq cx (/ (+ (nth 0 bb) (nth 2 bb)) 2.0)) (setq cy (/ (+ (nth 1 bb) (nth 3 bb)) 2.0)) + (setq label (cs-carrier-label ent nm)) (setq carriers (cons (list ent (car tags) (cadr tags) (nth 0 bb) (nth 1 bb) (nth 2 bb) (nth 3 bb) - cx cy) + cx cy label) carriers))) (princ (strcat "\n! Bounding-Box fehlgeschlagen fuer ILS-Block '" nm "'" (if *cs-last-error* (strcat " (" *cs-last-error* ")") ""))) ) ) - ;; --- Sensor --- + ;; --- Sensor (Entity + Referenzpunkt merken) --- (t (setq kind (cs-sensor-kind nm)) (if kind (progn (setq pt (cs-sensor-point ent ed kind)) (if (eq kind 'scanner) - (setq scanpts (cons pt scanpts)) - (setq seppts (cons pt seppts))))) + (setq scanlist (cons (list ent pt) scanlist)) + (setq seplist (cons (list ent pt) seplist))))) ) ) (setq i (1+ i)) ) - ;; --- 2. Sensoren den ILS-Bloecken zuordnen --- + ;; --- 2. Sensoren zuordnen: zuordnung schreiben bzw. markieren --- (setq scanCounts nil sepCounts nil n-scan-unassigned 0 n-sep-unassigned 0) - (foreach pt scanpts - (setq rec (cs-assign pt carriers)) + (foreach s scanlist + (setq sent (car s) spt (cadr s)) + (setq rec (cs-assign spt carriers)) (if rec - (setq scanCounts (cs-bump scanCounts (car rec))) - (setq n-scan-unassigned (1+ n-scan-unassigned)))) + (progn + (setq scanCounts (cs-bump scanCounts (car rec))) + (if (not (cs-set-att sent *zuordnung-tag* (nth 9 rec))) + (setq n-zuordnung-fehlt (1+ n-zuordnung-fehlt)))) + (progn + (setq n-scan-unassigned (1+ n-scan-unassigned)) + (cs-set-att sent *zuordnung-tag* "") + (cs-mark-unassigned sent)))) - (foreach pt seppts - (setq rec (cs-assign pt carriers)) + (foreach s seplist + (setq sent (car s) spt (cadr s)) + (setq rec (cs-assign spt carriers)) (if rec - (setq sepCounts (cs-bump sepCounts (car rec))) - (setq n-sep-unassigned (1+ n-sep-unassigned)))) + (progn + (setq sepCounts (cs-bump sepCounts (car rec))) + (if (not (cs-set-att sent *zuordnung-tag* (nth 9 rec))) + (setq n-zuordnung-fehlt (1+ n-zuordnung-fehlt)))) + (progn + (setq n-sep-unassigned (1+ n-sep-unassigned)) + (cs-set-att sent *zuordnung-tag* "") + (cs-mark-unassigned sent)))) - ;; --- 3. Attribute setzen und Bericht ausgeben --- + ;; --- 3. ANZAHL-Attribute setzen und Bericht ausgeben --- (princ "\n============================================") (princ "\n Sensor-Zaehlung je ILS-Block") (princ "\n============================================") @@ -322,8 +454,8 @@ ;; Separator = interne Kette-Separatoren + neu zugeordnete (setq newS ns) (setq newP (+ internSep nsep)) - ;; gefundene Anzahlen melden - (princ (strcat "\n " nm2 + ;; gefundene Anzahlen melden (mit Bezeichnung/Label) + (princ (strcat "\n " nm2 " [" (nth 9 rec) "]" ": Scanner(neu)=" (itoa ns) ", Separator intern=" (itoa internSep) " + manuell=" (itoa nsep))) @@ -341,14 +473,18 @@ ) (princ (strcat "\n--------------------------------------------" "\n ILS-Bloecke gesamt: " (itoa (length carriers)) - "\n Scanner gesamt: " (itoa (length scanpts)) + "\n Scanner gesamt: " (itoa (length scanlist)) " (nicht zugeordnet: " (itoa n-scan-unassigned) ")" - "\n Separator gesamt: " (itoa (length seppts)) + "\n Separator gesamt: " (itoa (length seplist)) " (nicht zugeordnet: " (itoa n-sep-unassigned) ")")) - (if (or (> n-scan-unassigned 0) (> n-sep-unassigned 0)) - (princ (strcat "\n Hinweis: Nicht zugeordnete Sensoren liegen" - "\n ausserhalb aller ILS-Block-Boxen. Ggf. *senstol*" - "\n erhoehen oder Platzierung pruefen."))) + (if (> (+ n-scan-unassigned n-sep-unassigned) 0) + (princ (strcat "\n " (itoa (+ n-scan-unassigned n-sep-unassigned)) + " nicht zugeordnete(r) Sensor(en) mit Kreis markiert" + " (Layer '" *mark-layer* "')."))) + (if (> n-zuordnung-fehlt 0) + (princ (strcat "\n WARNUNG: " (itoa n-zuordnung-fehlt) + " zugeordnete(r) Sensor(en) ohne Attribut '" + *zuordnung-tag* "' - Bezeichnung nicht schreibbar."))) ;; --- 4. Zeichnung speichern --- (princ "\n--------------------------------------------")