diff --git a/Lisp/ssg_core.lsp b/Lisp/ssg_core.lsp index bc040eb..2f6017c 100644 --- a/Lisp/ssg_core.lsp +++ b/Lisp/ssg_core.lsp @@ -787,7 +787,7 @@ ;; und Foerderer-Tests) fuehrte das zu minutenlangen Laufzeiten. ;; Zum erzwungenen Neu-Einlesen: ssg-block-refresh-reset. ;; Rueckgabe: effektiver (suffigierter) Blockname oder nil (Datei nicht gefunden). -(defun ssg-ils-block-laden-dim (blockname dim / eff datei base temp-obj osm areq adia) +(defun ssg-ils-block-laden-dim (blockname dim / eff datei base temp-obj osm areq adia n) (setq eff (ssg-ils-blockname-dim blockname dim)) (setq datei (ssg-ils-block-datei-dim blockname dim)) (if (null datei) @@ -825,8 +825,22 @@ (if (tblsearch "BLOCK" eff) (command "_.-INSERT" (strcat eff "=" datei) "_Y") ; Redefine bestehender Block (command "_.-INSERT" (strcat eff "=" datei))) ; neu (kein Redefine-Prompt) - (if (> (getvar "CMDACTIVE") 0) (command)) - (if (> (getvar "CMDACTIVE") 0) (command)) + ;; Robust statt fixer 2 Versuche abbrechen: manche Block-DWGs (z.B. + ;; abweichende INSUNITS) schieben eine zusaetzliche Rueckfrage ein, + ;; die zwei (command)-Aufrufe nicht immer leeren. Bleibt danach ein + ;; Befehl aktiv, verschluckt der NAECHSTE (command ...)-Aufruf des + ;; Aufrufers (die eigentliche Platzierung, z.B. hundm05:bau-sensor/ + ;; ils-insert-station) dessen Argumente als Antwort auf DIESEN noch + ;; offenen Prompt - Ursache eines real beobachteten kaputten Blocks + ;; (fehlende Attribute) beim letzten Element eines Testlaufs. + (setq n 0) + (while (and (> (getvar "CMDACTIVE") 0) (< n 10)) + (command) + (setq n (1+ n))) + (if (> (getvar "CMDACTIVE") 0) + (princ (strcat "\n[SSG] WARNUNG: Laden von '" eff + "' hat einen Befehl aktiv gelassen (CMDACTIVE > 0) -" + " nachfolgende Einfuegungen sind evtl. beschaedigt."))) (setvar "OSMODE" osm)(setvar "ATTREQ" areq)(setvar "ATTDIA" adia))) ;; Nur merken, wenn die Definition danach wirklich vorhanden ist - ;; sonst wuerde ein fehlgeschlagener Ladeversuch dauerhaft gesperrt. diff --git a/tests/test_hundm05.lsp b/tests/test_hundm05.lsp index 13a9b56..e579570 100644 --- a/tests/test_hundm05.lsp +++ b/tests/test_hundm05.lsp @@ -135,7 +135,7 @@ ;; jeder ueber ssg-ils-block-laden aufloesbare Blockname funktioniert. "sensor" ;; bleibt als Sammelbegriff fuer den "kind"-Wert (= "kein Kreisel"), auch wenn ;; inzwischen nicht mehr nur Separator/Scanner darueberlaufen. -(defun hundm05:bau-sensor (obj / id blockname x y z rotation pt eff n ent ed rec) +(defun hundm05:bau-sensor (obj / id blockname x y z rotation pt eff n vorher ent ed attribs rec) (setq id (ssg-val obj "id")) (setq blockname (ssg-val obj "block")) (setq x (ssg-val obj "x") @@ -172,6 +172,7 @@ (princ (strcat "\n [SENSOR] " id " '" blockname "' -> (" (rtos x 2 0) ", " (rtos y 2 0) ", " (rtos z 2 0) ") R=" (rtos rotation 2 1))) + (setq vorher (entlast)) (command "_.INSERT" eff pt "" "" rotation) ;; Verbleibende Prompts mit Enter abfangen, aber GEZAEHLT - siehe ;; mubea:build-separator-one (ein Prompt, der Leer-Antworten @@ -186,14 +187,45 @@ (princ (strcat "\n WARNUNG: INSERT von '" eff "' nicht sauber beendet - abgebrochen.")))) (setq ent (entlast)) - (if (atoms-family 1 '("ssg-id-generate")) (ssg-id-generate ent)) - (setq ed (entget ent)) - (princ (strcat " -> Block " (cdr (assoc 2 ed)))) - (setq rec (vsp-set rec "block_name" (cdr (assoc 2 ed)))) - (setq rec (vsp-set rec "block_handle" (cdr (assoc 5 ed)))) - (setq rec (vsp-set rec "insert_point" (cdr (assoc 10 ed)))) - (setq rec (vsp-set rec "attribs" (ssg-attrib-read ent))) - (vsp-set rec "status" "executed")))))) + ;; Nicht blind (entlast) vertrauen: eine verschluckte Rueckfrage beim + ;; Laden ODER Platzieren (siehe ssg-ils-block-laden-dim) kann eine + ;; unvollstaendige/falsche Blockreferenz ohne jedes Attribut hinterlassen + ;; (realer Fall: HundM05, letztes Zusatzobjekt = SC_Entladung, erste + ;; Verwendung dieses Blocknamens im Testlauf). Nur eine ECHT NEUE + ;; INSERT-Referenz gilt als Erfolg; alles andere wird als Fehler + ;; gemeldet und die kaputte Restgeometrie sofort entfernt statt sie + ;; unbemerkt in der Zeichnung zu belassen. + (cond + ((or (null ent) (eq ent vorher) + (/= (cdr (assoc 0 (entget ent))) "INSERT")) + (princ (strcat "\n [SENSOR] " id " '" blockname + "' - FEHLER: INSERT hat keine gueltige neue Blockreferenz" + " erzeugt (verschluckte Rueckfrage?).")) + (if (and ent (not (eq ent vorher))) (entdel ent)) + (setq rec (vsp-set (vsp-set rec "status" "abbruch") "fehler_text" + "INSERT lieferte keine gueltige neue Blockreferenz"))) + (T + (setq attribs (ssg-attrib-read ent)) + (setq ed (entget ent)) + (princ (strcat " -> Block " (cdr (assoc 2 ed)))) + (setq rec (vsp-set rec "block_name" (cdr (assoc 2 ed)))) + (setq rec (vsp-set rec "block_handle" (cdr (assoc 5 ed)))) + (setq rec (vsp-set rec "insert_point" (cdr (assoc 10 ed)))) + (setq rec (vsp-set rec "attribs" attribs)) + ;; ID nur vergeben, wenn der Block ueberhaupt ein ID-Attribut fuehrt + ;; (siehe ssg-id-set-and-verify in ssg_id.lsp) - sonst faellt hier + ;; dieselbe "unsichtbare" Luecke auf, statt sie in der ID-Vergabe zu + ;; verstecken. + (cond + ((not (assoc "ID" attribs)) + (princ (strcat "\n [SENSOR] " id " '" blockname + "' - WARNUNG: Block hat kein ID-Attribut (ATTDEF" + " fehlt/veraltet, ATTSYNC noetig) - keine ID vergeben.")) + (setq rec (vsp-set (vsp-set rec "status" "warnung") "fehler_text" + "Block ohne ID-ATTDEF - ATTSYNC noetig"))) + (T + (if (atoms-family 1 '("ssg-id-generate")) (ssg-id-generate ent)) + (vsp-set rec "status" "executed")))))))))) ;; Alle Zusatzobjekte der Datei bauen. Eigener ssg-start-Rahmen, weil ;; vsp-bau-datei seinen schon geschlossen hat; ATTREQ/ATTDIA 0 ist Pflicht -