ZAEHLE_SEP_SCAN schreibt ILS-Bezeichnung in Sensor-Attribut zuordnung und markiert nicht zugeordnete Sensoren mit Gelb Kreis
This commit is contained in:
+173
-37
@@ -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--------------------------------------------")
|
||||
|
||||
Reference in New Issue
Block a user