;; ============================================================ ;; KETTENFOERDERER.LSP - Schraegfoerderer Stahl (Omniflo) ;; ============================================================ ;; Baut aus drei vorhandenen Bloecken eine Kette zusammen und fasst sie zu ;; EINEM Block KF_ zusammen - dasselbe Muster wie KREISEL_n/VF_n/GF_n: ;; ;; KF_UM_ (Umlenkstation, unten) ;; KS_AUS --> KS_EIN ;; KF_LAENGE (Zwischenstueck, in X SKALIERT - wie die Staustrecke ;; beim VarioFoerderer) ;; KS_AUS --> KS_EIN ;; KF_AN_ (Antriebsstation, oben) ;; ;; GEOMETRIE - wichtigste Entwurfsentscheidung: ;; Die Neigung (26 bzw. 30 Grad) ist KEIN Rechenparameter. Sie steckt fest in ;; der Geometrie der Varianten-Bloecke (KF_UM_26 gegen KF_UM_30). Der ;; Einbauwinkel jedes Folgebausteins wird darum zur Laufzeit aus der RICHTUNG ;; des KS_AUS seines Vorgaengers gemessen (ks-xy-winkel/ks-block-messen in ;; ssg_ks_insert.lsp) - es gibt hier keine gepflegte Winkeltabelle, die beim ;; Austausch einer DWG veralten koennte. Der JSON-Wert "winkel" dient nur der ;; Variantenwahl, der Anzeige und dem Attribut KF_WINKEL. ;; ;; Die Bloecke sind eine 2D-SEITENANSICHT: die Steigung liegt in der ;; XY-Zeichenebene, die Hoehenachse ist Y (nicht Z wie bei VF/GF). Die ;; Neigung ist damit eine reine Rz-Drehung - deshalb genuegt ;; insert-block-by-ks/insert-block-ks-skaliert, die Rz*Ry-Primitiven des ;; VarioFoerderers werden hier nicht gebraucht. ;; ;; HAUPT- UND HILFSBLOCK: KF_ ist die Seitenansicht (ungedreht, Einfuege- ;; punkt = KS_EIN der Umlenkung) mit Beschriftung und Hoehenmass; nur dieser ;; Block wird exportiert. Die Draufsicht KF_2D ist ein getrennter Hilfsblock ;; KF2D_ (zum Anschliessen von Schienen), der aus der projizierten Laenge ;; entsteht, beim ersten Mal 1000 mm unter dem Hauptblock liegt, frei ;; verschiebbar und loeschbar ist und per Doppelklick auf KF_ neu erzeugt ;; wird. Beide tragen denselben Schluessel in der XDATA (SSG_KF_EDIT). ;; ;; Die Einbauhoehe H (Abstand KS_EIN der Umlenkung bis KS_AUS des Antriebs auf ;; der Y-Achse) bestimmt die Laenge des Zwischenstuecks ueber die ;; Hoehenbilanz, siehe kf-laenge-berechnen. ;; ;; Abhaengigkeiten: ssg_core, ssg_lang, ssg_layer, ssg_id, ssg_ks_insert, ;; OmniModulInsert (nur fuer omni:omniflo-datei-finden - die KF-DWGs liegen ;; wie alle Omniflo-Bauteile in data/omniflo//). ;; ============================================================ (vl-load-com) ;; modelspace/doc werden von den KS-Einfuegeprimitiven als GLOBALE Variablen ;; erwartet (gesetzt von vf_core.lsp bzw. Gefaellestrecke.lsp). Beim isolierten ;; Laden dieses Moduls - etwa in einem Testskript - ist noch keines davon ;; geladen, darum hier guarded nachziehen (gleiches Muster wie TEFInsert.lsp). (if (null doc) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))) (if (null modelspace) (setq modelspace (vla-get-ModelSpace doc))) ;; Einfuegeprimitiven guarded nachladen (die MNL laedt ssg_ks_insert als ;; Kernmodul, beim isolierten Test-Laden fehlt es aber). Geprueft wird ueber ;; atoms-family, nicht ueber (null ) - ein noch nie definiertes ;; Funktionssymbol ist zwar nil, ein definiertes liefert aber eine USUBR, und ;; die Abfrage waere damit vom Ladezustand abhaengig statt von der Existenz. (if (not (car (atoms-family 1 '("INSERT-BLOCK-KS-SKALIERT")))) (if (findfile (ssg-lisp-datei-pfad "ssg_ks_insert.lsp")) (load (ssg-lisp-datei-pfad "ssg_ks_insert.lsp")))) ;; ------------------------------------------------------------ ;; LAUFZEIT-PROTOKOLL (Schalter "kf-zeit") ;; ------------------------------------------------------------ ;; Schreibt Zwischenzeiten ueber ssg_dbg (dbgmsg) statt per princ ins ;; BricsCAD-Fenster - die Zeilen landen damit in einer .dbg-Datei im ;; DXFM_LOG-Verzeichnis und sind ueber den Schalter abschaltbar, koennen ;; also dauerhaft im Code bleiben (siehe Debug-Abschnitt in CLAUDE.md). ;; Einschalten: (dbg-schalter-setzen "kf-zeit" 1), dann KETTENFOERDERER. ;; Zweck: klaeren, wo die spuerbare Verzoegerung beim ersten Menueklick ;; entsteht (Lazy-Laden des Moduls / JSON lesen / Dialogaufbau). ;; Eigener Dateihandle statt dbgmsg: ssg_dbg fuehrt mit *dbg-path* genau EINE ;; global offene Datei - die Zeilen wuerden sonst stillschweigend in einem ;; fremden Protokoll landen (gleiche Ueberlegung wie bei ssg-sepliste-dbg). (if (not (boundp '*kf-zeit-pfad*)) (setq *kf-zeit-pfad* nil)) (defun kf-zeit (was t0 / dir fh) (if (and t0 (car (atoms-family 1 '("DBG-SCHALTER-P"))) (dbg-schalter-p "kf-zeit")) (progn (if (null *kf-zeit-pfad*) (progn (setq dir (getenv "DXFM_LOG")) (if (or (null dir) (= dir "")) (setq dir ".")) (setq *kf-zeit-pfad* (strcat dir "\\kf_zeit.dbg")))) (setq fh (open *kf-zeit-pfad* "a")) (if fh (progn (write-line (strcat was ": " (itoa (fix (- (getvar "MILLISECS") t0))) " ms seit Befehlsstart") fh) (close fh))))) (princ)) ;; ============================================================ ;; DATEN (data/json/kettenfoerderer.json) ;; ============================================================ ;; Verschachteltes JSON -> ssg-json-laden (rekursiver Parser), NICHT der ;; zeilenbasierte ssg-load-json: die Datei hat verschachtelte Objekte und ;; Kommas in den Beschreibungstexten. (if (not (boundp '*kf-daten*)) (setq *kf-daten* nil)) (defun kf-daten-datei ( / basis) (setq basis (getenv "DXFM_DATA")) (if (or (null basis) (= basis "")) (setq basis (strcat (getenv "DXFMAKRO") "/data"))) (strcat basis "/json/kettenfoerderer.json")) ;; Geladene Daten (Cache). kf-daten-reset erzwingt das Neulesen nach einer ;; Aenderung an der JSON, ohne BricsCAD neu zu starten. (defun kf-daten ( / datei roh) (if (null *kf-daten*) (progn (setq datei (kf-daten-datei)) (if (findfile datei) (progn (setq roh (ssg-json-laden datei)) (setq *kf-daten* (ssg-json-get roh "kettenfoerderer"))) (princ (ssg-textf "kf-fehler-daten-fehlt" (list datei)))))) *kf-daten*) (defun kf-daten-reset ( ) (setq *kf-daten* nil) (princ)) ;; ============================================================ ;; REINE RECHENKERNE (ohne Zeichnung/Datei testbar - tests/test_unit.lsp) ;; ============================================================ ;; JSON-Wert als Zahl. Der Parser liefert Zahlen je nach Schreibweise als ;; REAL/INT oder (bei gequoteten Werten) als String - beides zulassen. (defun kf-zahl (v) (cond ((null v) nil) ((numberp v) (float v)) ((= (type v) 'STR) (atof v)) (t nil))) ;; Laenge des skalierbaren Zwischenstuecks aus der Hoehenbilanz. ;; H = dy-um + [ L*sin(hz) + dy-nativ*cos(hz) ] + dy-an ;; aufgeloest nach L. Der Term dy-nativ*cos(hz) faellt weg, wenn das ;; Zwischenstueck waagerecht gezeichnet ist (Normalfall) - er steht hier, ;; damit auch ein bereits geneigt gezeichnetes KF_LAENGE richtig gerechnet ;; wird. dy-nativ skaliert BEWUSST nicht mit: skaliert wird nur in X. ;; h-soll gewuenschte Einbauhoehe H (mm) ;; dy-um Y-Versatz der eingebauten Umlenkstation ;; dy-an Y-Versatz der eingebauten Antriebsstation ;; dy-nativ Y-Anteil des KS_AUS-KS_EIN-Versatzes von KF_LAENGE (Blockmass) ;; hz Einbauwinkel des Zwischenstuecks (Grad) ;; Rueckgabe: Laenge entlang der Blockachse (mm), oder nil wenn die Neigung ;; keinen Hoehengewinn liefert (sin(hz)=0 - dann ist H nicht erreichbar). (defun kf-laenge-berechnen (h-soll dy-um dy-an dy-nativ hz / rad sh ch rest) (setq rad (* (float hz) (/ pi 180.0))) (setq sh (sin rad) ch (cos rad)) (if (< (abs sh) 1e-9) nil (progn (setq rest (- (float h-soll) (float dy-um) (float dy-an) (* (float dy-nativ) ch))) (/ rest sh)))) ;; X-Massstab fuer KF_LAENGE: gewuenschte Laenge / native Blocklaenge. ;; nil, wenn der Block keine messbare X-Laenge hat. (defun kf-skala-berechnen (laenge dx-nativ) (if (or (null laenge) (null dx-nativ) (< (abs dx-nativ) 1e-9)) nil (/ (float laenge) (float dx-nativ)))) ;; Errechnete Laenge gegen die Grenzen aus der JSON pruefen. ;; Rueckgabe: nil = in Ordnung, sonst der Sprach-Key der Meldung. (defun kf-laenge-pruefen (laenge lmin lmax) (cond ((null laenge) "kf-fehler-winkel-null") ((<= laenge 0.0) "kf-fehler-hoehe-zu-klein") ((and lmin (< laenge (float lmin))) "kf-fehler-laenge-unter-min") ((and lmax (> laenge (float lmax))) "kf-fehler-laenge-ueber-max") (t nil))) ;; Y-Anteil des KS_AUS-KS_EIN-Versatzes nach Einbau mit Rz(hz) und X-Massstab. ;; In der 2D-Seitenansicht ist Y die Hoehenachse. (defun kf-dy-eingebaut (dx-nativ dy-nativ hz skala / rad) (setq rad (* (float hz) (/ pi 180.0))) (+ (* (* (float skala) (float dx-nativ)) (sin rad)) (* (float dy-nativ) (cos rad)))) ;; Einbauwinkel (Rz, Grad) eines Folgebausteins: sein KS_EIN soll in dieselbe ;; Richtung zeigen wie das KS_AUS seines Vorgaengers. ;; hz = Weltrichtung(KS_AUS Vorgaenger) - Eigenrichtung(KS_EIN Folgebaustein) ;; Fehlt die Eigenrichtung des Folgebausteins, wird er wie sein Vorgaenger ;; ausgerichtet; fehlt die Vorgaengerrichtung, ist keine Aussage moeglich (nil). (defun kf-hz-folge (phi-aus beta-ein) (cond ((null phi-aus) nil) ((null beta-ein) (ks-winkel-normalisieren phi-aus)) (t (ks-winkel-normalisieren (- phi-aus beta-ein))))) ;; Variante zu einem Winkel suchen. Rueckgabe: Varianten-Objekt oder nil. (defun kf-variante-finden (winkel varianten / treffer w) (setq treffer nil) (foreach v varianten (setq w (kf-zahl (ssg-json-get v "winkel"))) (if (and (null treffer) w (< (abs (- w (float winkel))) 0.01)) (setq treffer v))) treffer) ;; ------------------------------------------------------------ ;; ATTRIBUT-SCHEMA ;; ------------------------------------------------------------ ;; EIGENSTAENDIGE Liste - bewusst NICHT vom Strecken-Schema des ;; VarioFoerderers (`ssg-strecke-attrib-defs`) abgeleitet. Anfangs war sie ;; das, was dem Block rund zwei Dutzend geerbte Tags eintrug, die der ;; Kettenfoerderer gar nicht kennt (SEITE_AS/ES, GF_Bogen_*, ANZAHL_VF, ;; MOTORSEITE, VF_Bogen_*, ANZAHL_SEPARATOR ...). Sie standen leer am Block, ;; waren im Attributeditor nur Ballast und haetten im Export Werte ;; vorgetaeuscht, die es hier nicht gibt. Eine explizite Liste ist zudem ;; leichter zu lesen als eine Erbung mit Ausnahmeliste. ;; ;; Was die Tags bedeuten: ;; ID - vergibt ssg-id-generate (Voraussetzung fuer den Export) ;; Bezeichnung - Blockname KF_, CSV-Spalte ;; ARTINR - Sivas-Artikelnummer, CSV-Spalte "SivasNummer" ;; FOERDERERTYP - Bauart im Klartext ("Schraegfoerderer Stahl"), ;; Merkmal 350. Der Wert kommt aus der JSON ;; (Feld "foerderertyp"), nicht aus dem Code - so ;; bleibt diese Datei frei von Sonderzeichen und der ;; Text ist an einer Stelle pflegbar. ;; WINKEL - Neigungswinkel als nackte Zahl ("26"/"30"). ;; Den Sivas-Klartext mit Gradzeichen erzeugt erst die ;; Tabelle [kf_typ_anzeige] (cfg/sivas.cfg, Merkmal ;; 359) - Attributwerte bleiben so ASCII. ;; STANDARD_STEUERUNG - Merkmal 361, "1"/"0" ueber Transform ja_nein. ;; Steht direkt hinter WINKEL, wie im Merkmalstamm. ;; H_EINBAUHOEHE_mm - Merkmal 360 ;; L_KF_mm - WAAGERECHTE Laenge des ganzen Foerderers (der Draufsicht ;; KF_2D), CSV-Spalte "Laenge" ;; FARBE - Merkmal 354 ;; ANTRIEBSMOTOR - Merkmal 355 (eigenes Merkmal, nicht Teil von 354) ;; ANTRIEBSART - Merkmal 357, FEST "1.1 kW" (Wert aus der JSON, ;; im Dialog ein Dropdown mit EINER, zwingend gewaehlten Option) ;; MOVIMOT - Merkmal 356, "1"/"0" ueber Transform ja_nein ;; VERBINDUNGSELEMENTE - Merkmal 391 ;; LAYER - Ziel-Layer der Baugruppe ;; ;; KEINE TEILEART: sie ist fuer jeden Kettenfoerderer gleich und steht darum ;; als Festwert im Export (KF_TEILEART in export_sivas.py) statt an jedem ;; Block. Die Erkennung laeuft ohnehin ueber den Blocknamen (pattern_ ;; kettenfoerderer), nicht ueber TEILEART. (setq *kf-attrib-defs-liste* '(("ID" "") ("Bezeichnung" "") ("ARTINR" "") ("FOERDERERTYP" "Schraegfoerderer Stahl") ("WINKEL" "26") ;; Reihenfolge wie im Sivas-Merkmalstamm: 361 folgt direkt auf den Typ. ("STANDARD_STEUERUNG" "0") ("H_EINBAUHOEHE_mm" "0") ("L_KF_mm" "0") ("FARBE" "RAL 7035") ("ANTRIEBSMOTOR" "Europa 50 Hz") ;; Merkmal 357 - beim Kettenfoerderer fest, im Dialog nur Anzeige. ("ANTRIEBSART" "1.1 kW") ("MOVIMOT" "0") ("VERBINDUNGSELEMENTE" "Nein") ("LAYER" "F-3"))) (defun kf-attrib-defs ( ) *kf-attrib-defs-liste*) ;; Antriebsart (Merkmal 357). Beim Kettenfoerderer gibt es genau EINE Option ;; ("1.1 kW"), die im Dialog zwingend gewaehlt ist. Sie steht als Liste in der ;; JSON (wie alle anderen Auswahlen), nicht im Code. Rueckgabe: der "wert" des ;; ERSTEN Eintrags - bei einer Ein-Eintrag-Liste also immer derselbe Wert. (defun kf-antriebsart (daten) (kf-auswahl-wert (ssg-json-get daten "antriebsart") 0 "1.1 kW")) ;; Position eines Tags in einer ATTDEF-Liste (0-basiert), nil wenn nicht ;; enthalten. Die REIHENFOLGE ist nicht beliebig: sie bestimmt, in welcher ;; Folge die Attribute im Blockeditor und in den Exportzeilen erscheinen, und ;; folgt darum dem Sivas-Merkmalstamm. Reiner Kern, in test_unit geprueft. (defun kf-tag-index (tag defs / i treffer) (setq i 0 treffer nil) (foreach d defs (if (and (null treffer) (= (car d) tag)) (setq treffer i)) (setq i (1+ i))) treffer) ;; ============================================================ ;; BLOCK-DATEIEN (data/omniflo//) ;; ============================================================ ;; Die KF-Bloecke liegen - anders als die ILS-Bloecke in data/ils (flach, mit ;; Dimensionssuffix _2D/_3D) - in den Omniflo-Ordnern ohne Suffix. Die ;; KS-Primitiven in ssg_ks_insert.lsp suchen ueber ssg-ils-block-laden aber in ;; data/ils. Darum wird die Blockdefinition HIER vorab aus dem Omniflo-Ordner ;; in die Zeichnung geladen; ensure-block-loaded findet sie dann per ;; tblsearch bereits vor und laesst sie unangetastet. (defun kf-block-laden (blockname / pfad omniflo-pfad temp-obj) (if (tblsearch "BLOCK" blockname) blockname (progn (setq omniflo-pfad (getenv "DXFM_OMNIFLO")) (setq pfad (if (and omniflo-pfad (car (atoms-family 1 '("OMNI:OMNIFLO-DATEI-FINDEN")))) (omni:omniflo-datei-finden blockname omniflo-pfad) nil)) ;; Rueckfall ohne OmniModulInsert/DXFM_OMNIFLO: direkt im Datenordner (if (null pfad) (setq pfad (kf-block-datei-direkt blockname))) (if pfad (progn ;; vla-InsertBlock mit DATEIPFAD definiert den Block unter seinem ;; Dateinamen (gleiches Vorgehen wie dinformate-block-laden). (setq temp-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) pfad 1.0 1.0 1.0 0)) (if (and temp-obj (not (vlax-erased-p temp-obj))) (vla-Delete temp-obj)) (if (tblsearch "BLOCK" blockname) blockname nil)) (progn (princ (ssg-textf "kf-fehler-block-datei" (list blockname))) nil))))) ;; Blockdatei ohne DXFM_OMNIFLO suchen: data/omniflo// in der aktuellen ;; Dimension, dann in der anderen (der 3D-Datenbestand ist unvollstaendig). (defun kf-block-datei-direkt (blockname / basis dim kandidaten treffer) (setq basis (getenv "DXFM_DATA")) (if (or (null basis) (= basis "")) (setq basis (strcat (getenv "DXFMAKRO") "/data"))) (setq dim (if (car (atoms-family 1 '("SSG-ILS-DIM-AKTUELL"))) (ssg-ils-dim-aktuell) "2D")) (setq kandidaten (list (strcat basis "/omniflo/" dim "/" blockname ".dwg") (strcat basis "/omniflo/" dim "/" blockname ".dxf") (strcat basis "/omniflo/" (if (= dim "2D") "3D" "2D") "/" blockname ".dwg") (strcat basis "/omniflo/" (if (= dim "2D") "3D" "2D") "/" blockname ".dxf"))) (setq treffer nil) (foreach k kandidaten (if (and (null treffer) (findfile k)) (setq treffer (findfile k)))) treffer) ;; ============================================================ ;; GEOMETRIE EINER VARIANTE MESSEN ;; ============================================================ ;; Misst alle drei Bloecke EINMAL und leitet daraus die Einbauwinkel und die ;; Hoehenbeitraege ab. Ergebnis ist ein Record (Assoc-Liste), den der Dialog ;; fuer die Laengenvorschau und der Bau fuer die eigentliche Verkettung nutzt - ;; gemessen wird also genau einmal je Variante. ;; ;; Felder: "hz-um" "hz-l" "hz-an" Einbauwinkel (Grad, relativ zur Basisdrehung) ;; "dy-um" "dy-an" Hoehenbeitrag der beiden Stationen ;; "dx-l" "dy-l" nativer KS-Versatz von KF_LAENGE ;; "fehler" Sprach-Key, falls etwas fehlt (sonst nil) (defun kf-geometrie-messen (variante / b-um b-l b-an ks-um ks-l ks-an v-um v-l v-an beta-aus-um beta-ein-l beta-aus-l beta-ein-an hz-um hz-l hz-an dy-um dy-an fehler) (setq b-um (ssg-json-get variante "block_umlenkung") b-l (ssg-json-get variante "block_laenge") b-an (ssg-json-get variante "block_antrieb")) (setq fehler nil) (if (not (and (kf-block-laden b-um) (kf-block-laden b-l) (kf-block-laden b-an))) (setq fehler "kf-fehler-block-datei") (progn (setq ks-um (ks-block-messen b-um) ks-l (ks-block-messen b-l) ks-an (ks-block-messen b-an)) (setq v-um (ks-versatz ks-um) v-l (ks-versatz ks-l) v-an (ks-versatz ks-an)) (if (not (and v-um v-l v-an)) ;; Welcher Baustein klemmt, gehoert ins Protokoll: die Meldung allein ;; ("in mindestens einem Baustein fehlt ein KS") hat bei einem realen ;; Fehlschlag nicht gereicht, um die Ursache zu finden - sie lag nicht ;; an den Bloecken, sondern an einem falsch aufgeloesten Blocknamen ;; (siehe ensure-block-loaded in ssg_ks_insert.lsp). (progn (foreach paar (list (cons b-um v-um) (cons b-l v-l) (cons b-an v-an)) (if (null (cdr paar)) (princ (ssg-textf "kf-pruef-ks-fehlt-kurz" (list (car paar)))))) (setq fehler "kf-fehler-ks-fehlt")) (progn ;; Eigenrichtungen der KS in Blockkoordinaten (setq beta-aus-um (ks-xy-winkel (cadr (assoc "KS_AUS" ks-um))) beta-ein-l (ks-xy-winkel (cadr (assoc "KS_EIN" ks-l))) beta-aus-l (ks-xy-winkel (cadr (assoc "KS_AUS" ks-l))) beta-ein-an (ks-xy-winkel (cadr (assoc "KS_EIN" ks-an)))) ;; Die Umlenkstation gibt die Basisrichtung vor (hz 0); jeder ;; Folgebaustein richtet sich am KS_AUS seines Vorgaengers aus. (setq hz-um 0.0) (setq hz-l (cond ((kf-hz-folge (if beta-aus-um (+ beta-aus-um hz-um) nil) beta-ein-l)) (0.0))) (setq hz-an (cond ((kf-hz-folge (if beta-aus-l (+ beta-aus-l hz-l) nil) beta-ein-an)) (hz-l))) ;; Hoehenbeitrag der beiden Stationen (Massstab 1) (setq dy-um (kf-dy-eingebaut (car v-um) (cadr v-um) hz-um 1.0)) (setq dy-an (kf-dy-eingebaut (car v-an) (cadr v-an) hz-an 1.0)))))) (list (cons "fehler" fehler) (cons "hz-um" (cond (hz-um) (0.0))) (cons "hz-l" (cond (hz-l) (0.0))) (cons "hz-an" (cond (hz-an) (0.0))) (cons "dy-um" (cond (dy-um) (0.0))) (cons "dy-an" (cond (dy-an) (0.0))) (cons "dx-l" (cond ((car v-l)) (0.0))) (cons "dy-l" (cond ((cadr v-l)) (0.0))))) ;; Laenge + Massstab fuer eine Hoehe aus einem gemessenen Geometrie-Record. ;; Rueckgabe: (laenge skala fehler-key) - laenge/skala nil bei Fehler. (defun kf-laenge-fuer-hoehe (geo hoehe lmin lmax / laenge skala key) (if (cdr (assoc "fehler" geo)) (list nil nil (cdr (assoc "fehler" geo))) (progn (setq laenge (kf-laenge-berechnen hoehe (cdr (assoc "dy-um" geo)) (cdr (assoc "dy-an" geo)) (cdr (assoc "dy-l" geo)) (cdr (assoc "hz-l" geo)))) (setq key (kf-laenge-pruefen laenge lmin lmax)) (if key (list nil nil key) (progn (setq skala (kf-skala-berechnen laenge (cdr (assoc "dx-l" geo)))) (if (null skala) (list nil nil "kf-fehler-ks-fehlt") (list laenge skala nil))))))) ;; ============================================================ ;; KETTE BAUEN (Seitenansicht) ;; ============================================================ ;; Fuegt die drei Bausteine ab startpunkt verkettet ein. Die Kette ist eine ;; SEITENANSICHT: sie liegt flach in der XY-Ebene (X = Fahrtrichtung, ;; Y = Hoehe), so wie die Bausteine gezeichnet sind. Es wird nichts ;; aufgerichtet und nichts gedreht; jeder Baustein bekommt nur den aus den KS ;; gemessenen Verkettungswinkel (kf-hz-folge). ;; (Zwischenzeitlich wurde die Kette aufgerichtet in Z eingebaut - nach ;; Abstimmung wieder zurueckgenommen; die Draufsicht ist jetzt ein EIGENER ;; Hilfsblock, siehe kf-hilfsblock-bauen.) ;; Rueckgabe: Weltpunkt des KS_AUS der Antriebsstation (Kettenende). (defun kf-kette-bauen (variante geo skala startpunkt / pt) (setq pt startpunkt) (setq pt (insert-block-by-ks (ssg-json-get variante "block_umlenkung") pt (cdr (assoc "hz-um" geo)))) (setq pt (insert-block-ks-skaliert (ssg-json-get variante "block_laenge") pt (cdr (assoc "hz-l" geo)) skala)) (setq pt (insert-block-by-ks (ssg-json-get variante "block_antrieb") pt (cdr (assoc "hz-an" geo)))) pt) ;; ------------------------------------------------------------ ;; MASSE AUS START- UND ENDPUNKT (reine Rechenkerne) ;; ------------------------------------------------------------ ;; Horizontalanteil von p1 nach p2, auf die Kettenrichtung (basis-hz, Grad) ;; projiziert und nicht die blosse X-Differenz - sonst stimmt es bei einem von ;; Hand gedrehten Block nicht. Die Hoehe (Y) geht NICHT ein. (defun kf-horiz-projektion (p1 p2 basis-hz / rad dx dy) (setq rad (* (float basis-hz) (/ pi 180.0))) (setq dx (- (car p2) (car p1)) dy (- (cadr p2) (cadr p1))) (+ (* dx (cos rad)) (* dy (sin rad)))) ;; WAAGERECHTE (projizierte) Laenge der Kette = Laenge der Draufsicht KF_2D. ;; Das ist der Wert im Attribut L_KF_mm. Immer positiv. (defun kf-waagerecht-laenge (p1 p2 basis-hz) (abs (kf-horiz-projektion p1 p2 basis-hz))) ;; Neigungswinkel der Variante als nackte Ganzzahl ("26"/"30"), bewusst ueber ;; itoa/fix statt rtos: rtos haengt an DIMZIN/LUPREC/LUNITS der Zeichnung. Der ;; Wert steht im Attribut WINKEL und ist Schluessel der Tabelle ;; [kf_typ_anzeige] im Sivas-Export - er muss profilunabhaengig sein. (defun kf-winkel-text (variante) (itoa (fix (+ 0.5 (cond ((kf-zahl (ssg-json-get variante "winkel"))) (0.0)))))) ;; Punkt um versatz-y in Y verschoben (Z bleibt, fehlendes Z = 0). (defun kf-versatzpunkt (p versatz-y) (list (car p) (+ (cadr p) (float versatz-y)) (cond ((caddr p)) (0.0)))) ;; Versatz des Hilfsblocks (Draufsicht) gegen den Hauptblock beim ERSTEN ;; Einfuegen, in mm (Y). Steht in der JSON, nicht im Code; Vorgabe -1000. ;; (Pruefung ueber if, nicht ueber and/or: and liefert T statt der Zahl.) (defun kf-hilfsblock-versatz (daten / cfg wert) (setq cfg (ssg-json-get daten "ansicht_2d")) (setq wert (if cfg (kf-zahl (ssg-json-get cfg "versatz_y")))) (cond (wert) (-1000.0))) ;; ------------------------------------------------------------ ;; BESCHRIFTUNG UND HOEHENMASS ;; ------------------------------------------------------------ ;; Beschriftung wie bei VF_/GF_ (gf-make-label): ein TEXT, Hoehe 100, auf ;; einem eigenen Layer aus cfg/layer.cfg. Haupt- und Hilfsblock tragen ;; dieselbe Zeile: "KF_1 26 Grad-Zeichen H=1500mm L_horizontal=4951mm". (defun kf-label-text (nummer winkel-str hoehe waagerecht) (strcat "KF_" (itoa nummer) " " winkel-str (chr 176) " H=" (itoa (fix (+ 0.5 (float hoehe)))) "mm" " L_horizontal=" (itoa (fix (+ 0.5 (float waagerecht)))) "mm")) ;; Layer der Beschriftung (Baugruppe "kettenfoerderer_beschriftung" in ;; cfg/layer.cfg), sonst Hartwert - wie bei GF_/VF_. (defun kf-beschriftungs-layer ( / lay) (setq lay (ssg-layer-anlegen "kettenfoerderer_beschriftung" nil)) (if (null lay) (progn (setq lay "KF_Beschriftung") (ssg-make-layer lay "7" nil))) lay) (defun kf-label-zeichnen (txt pt lay) (entmake (list '(0 . "TEXT") (cons 10 pt) (cons 11 pt) '(40 . 100.0) (cons 1 txt) '(7 . "Standard") (cons 8 lay) '(72 . 1) '(73 . 2))) (princ)) ;; Senkrechtes Hoehenmass zwischen p-unten und p-oben, rechts neben dem ;; Kettenende. Echtes DIMENSION-Objekt per ActiveX (AddDimRotated, 90 Grad) - ;; kein Befehlsaufruf, der bei einem Fehler im Befehl haengen bleiben koennte. ;; Jeder Schritt laeuft unter vl-catch-all-apply: scheitert das Mass, geht der ;; Bau OHNE Mass weiter und meldet es (Hinweis, kein Abbruch). Textgroesse und ;; Pfeile werden gesetzt, damit das Mass neben der 100-mm-Beschriftung lesbar ;; ist; fehlt eine Eigenschaft, bleibt der Wert der Bemassungsvariablen. (defun kf-hoehenmass-zeichnen (p-unten p-oben lay / obj) (setq obj (vl-catch-all-apply 'vla-AddDimRotated (list modelspace (vlax-3d-point p-unten) (vlax-3d-point p-oben) (vlax-3d-point (list (+ (car p-oben) 400.0) (/ (+ (cadr p-unten) (cadr p-oben)) 2.0) (caddr p-oben))) (/ pi 2.0)))) (if (vl-catch-all-error-p obj) (progn (princ (ssg-text "kf-bemassung-fehlt")) nil) (progn (foreach prop (list (list 'vla-put-TextHeight 100.0) (list 'vla-put-ArrowheadSize 50.0) (list 'vla-put-PrimaryUnitsPrecision 0) (list 'vla-put-Layer lay)) (vl-catch-all-apply (car prop) (cons obj (cdr prop)))) T))) ;; Alles seit last-ent Entstandene als Auswahlsatz (fuer _.-BLOCK). (defun kf-sammeln (last-ent / ss ent) (setq ss (ssadd)) (setq ent (if last-ent (entnext last-ent) (entnext))) (while ent (ssadd ent ss) (setq ent (entnext ent))) ss) ;; Referenz um rot-rad (Bogenmass) um ihren Einfuegepunkt drehen. Der Block ;; wird immer ungedreht gebaut (ssg-block-wrap-welt fuegt mit Drehung 0 ein); ;; eine von Hand vorgenommene Drehung wird so beim Neuaufbau wieder aufgesetzt. (defun kf-rotation-setzen (ent rot-rad / ed) (if (and ent rot-rad (/= rot-rad 0.0)) (progn (setq ed (entget ent)) (if (assoc 50 ed) (entmod (subst (cons 50 rot-rad) (assoc 50 ed) ed))))) ent) ;; ============================================================ ;; SCHLUESSEL ZWISCHEN HAUPT- UND HILFSBLOCK (XDATA) ;; ============================================================ ;; Haupt- (KF_) und Hilfsblock (KF2D_) tragen denselben Schluessel als ;; XDATA. Der Name taugt dafuer nicht: die Nummer wechselt bei JEDEM Neuaufbau ;; (KF_EDIT vergibt eine neue). Mit dem Schluessel findet KF_EDIT den ;; Hilfsblock auch dann, wenn der Benutzer ihn verschoben hat, und erzeugt ihn ;; an seiner jetzigen Stelle neu (Projektregel: Editierdaten gehoeren in ;; XDATA, nicht in .dbg). (setq *kf-xdata-app* "SSG_KF_EDIT") (defun kf-neuer-key () (ssg-timestamp)) (defun kf-xdata-schreiben (ent key / eintrag) (regapp *kf-xdata-app*) (setq eintrag (list *kf-xdata-app* (cons 1000 "kf-edit") (cons 1000 key))) (entmod (append (entget ent) (list (list -3 eintrag)))) ent) ;; Schluessel aus einer entget-Liste mit XDATA (reiner Kern, testbar): das ;; ZWEITE 1000-Feld; nil bei fehlender oder Altbestands-XDATA (nur Marker). (defun kf-key-aus-xdata (xd / daten teile) (setq daten (cdr (assoc -3 xd)) teile '()) (if daten (foreach p (cdr (car daten)) (if (= (car p) 1000) (setq teile (append teile (list (cdr p))))))) (if (>= (length teile) 2) (cadr teile) nil)) (defun kf-xdata-key (ent) (kf-key-aus-xdata (entget ent (list *kf-xdata-app*)))) ;; Hilfsblock (KF2D_*) mit diesem Schluessel suchen; nil, wenn es keinen gibt ;; (nie gebaut oder vom Benutzer geloescht). (defun kf-hilfsblock-finden (key / ss i e treffer) (setq treffer nil) (if key (progn (regapp *kf-xdata-app*) (setq ss (ssget "X" (list '(0 . "INSERT") '(2 . "KF2D_*") (list -3 (list *kf-xdata-app*))))) (if ss (progn (setq i 0) (while (and (null treffer) (< i (sslength ss))) (setq e (ssname ss i)) (if (equal (kf-xdata-key e) key) (setq treffer e)) (setq i (1+ i))))))) treffer) ;; ============================================================ ;; HILFSBLOCK KF2D_ (Draufsicht) ;; ============================================================ ;; Die Draufsicht KF_2D ist KEIN Teil des Foerderers, sondern ein ;; Hilfsblock, an dem der Benutzer Schienen anschliesst. Darum: ;; - eigener Block KF2D_ (nicht KF_*): die Export-Muster erfassen ihn nicht, ;; exportiert wird nur der Hauptblock KF_ ;; - flach in der XY-Ebene, auf die PROJIZIERTE Laenge des Foerderers skaliert ;; - unabhaengig verschiebbar; loescht der Benutzer ihn, bleibt der Hauptblock ;; unberuehrt, und KF_EDIT erzeugt ihn bei Bedarf neu ;; - traegt dieselbe Beschriftung wie der Hauptblock ;; Rueckgabe: die Referenz, sonst nil. (defun kf-hilfsblock-bauen (daten nummer key winkel-str hoehe waagerecht einfuegepunkt rot-rad / cfg bname ks ein-dx skala last-ent lay hname ss ins) (setq cfg (ssg-json-get daten "ansicht_2d")) (setq bname (if cfg (ssg-json-get cfg "block"))) (cond ((or (null bname) (= bname "")) nil) ((null (kf-block-laden bname)) (princ (ssg-textf "kf-fehler-block-datei" (list bname))) nil) (t (setq ks (ks-block-messen bname)) (setq ein-dx (car (cond ((ks-versatz ks)) ('(0.0 0.0 0.0))))) (setq skala (kf-skala-berechnen waagerecht ein-dx)) (if (null skala) (progn (princ (ssg-textf "kf-2d-ks-fehlt" (list bname))) nil) (progn (setq hname (strcat "KF2D_" (itoa nummer))) (setq last-ent (ssg-lastent-ohne-attribute)) (insert-block-ks-skaliert bname einfuegepunkt 0.0 skala) (setq lay (kf-beschriftungs-layer)) (kf-label-zeichnen (kf-label-text nummer winkel-str hoehe waagerecht) (list (+ (car einfuegepunkt) (/ waagerecht 2.0)) (+ (cadr einfuegepunkt) 250.0) (cond ((caddr einfuegepunkt)) (0.0))) lay) (setq ss (kf-sammeln last-ent)) (ssg-block-wrap-welt hname einfuegepunkt ss) (setq ins (entlast)) (ssg-layer-setzen ins (cond ((ssg-json-get daten "layer")) ("kettenfoerderer"))) (kf-rotation-setzen ins rot-rad) (kf-xdata-schreiben ins key) (princ (ssg-textf "kf-2d-gebaut" (list hname (rtos waagerecht 2 0)))) ins))))) ;; ============================================================ ;; BLOCK ABSCHLIESSEN ;; ============================================================ ;; Beschriftung und Hoehenmass zeichnen, alle seit last-ent erzeugten Objekte ;; sammeln, ATTDEFs anlegen und alles zu KF_ zusammenfassen. Vorbild: ;; gf-block-erstellen (Gefaellestrecke.lsp). ;; waagerecht = projizierte Laenge (Attribut L_KF_mm), key = Schluessel zum ;; Hilfsblock, rot-rad = von Hand gesetzte Drehung der Referenz (0 beim ersten ;; Einfuegen). (defun kf-block-erstellen (variante geo hoehe waagerecht verbindung startpunkt endpunkt last-ent kf-nummer farbe antriebsmotor movimot steuerung key rot-rad / kf-bname kf-ss kf-insert winkel-str lay z) (setq kf-bname (strcat "KF_" (itoa kf-nummer))) (setq winkel-str (kf-winkel-text variante)) (setq z (cond ((caddr startpunkt)) (0.0))) ;; ATTDEFs (unsichtbar, am Startpunkt) nach dem KF-Schema (foreach def (kf-attrib-defs) (entmake (list '(0 . "ATTDEF") (cons 10 startpunkt) (cons 11 startpunkt) '(40 . 50.0) (cons 1 (cadr def)) (cons 2 (car def)) (cons 3 (car def)) '(70 . 1) '(72 . 0) '(74 . 0)))) ;; Beschriftung unter der Kette, Hoehenmass rechts neben dem Kettenende (setq lay (kf-beschriftungs-layer)) (kf-label-zeichnen (kf-label-text kf-nummer winkel-str hoehe waagerecht) (list (/ (+ (car startpunkt) (car endpunkt)) 2.0) (- (cadr startpunkt) 300.0) z) lay) (kf-hoehenmass-zeichnen (list (car endpunkt) (cadr startpunkt) z) (list (car endpunkt) (cadr endpunkt) z) lay) (setq kf-ss (kf-sammeln last-ent)) ;; Block definieren und einfuegen (OSMODE/ELEVATION/BKS werden dabei sauber ;; abgeschaltet, siehe ssg-block-wrap-welt) (ssg-block-wrap-welt kf-bname startpunkt kf-ss) (setq kf-insert (entlast)) (ssg-layer-setzen kf-insert (cond ((ssg-json-get variante "layer")) ((ssg-json-get (kf-daten) "layer")) ("kettenfoerderer"))) (ssg-attrib-set-on kf-insert (list (cons "Bezeichnung" kf-bname) ;; FOERDERERTYP = Bauart im Klartext (aus der JSON, mit Sonderzeichen), ;; WINKEL = Neigungswinkel als nackte Zahl ("26"/"30") (cons "FOERDERERTYP" (cond ((ssg-json-get (kf-daten) "foerderertyp")) ("Schraegfoerderer Stahl"))) (cons "WINKEL" winkel-str) (cons "H_EINBAUHOEHE_mm" (itoa (fix (+ 0.5 (float hoehe))))) ;; WAAGERECHTE (projizierte) Laenge des ganzen Foerderers, nicht die ;; Laenge des schraegen Mittelstuecks (cons "L_KF_mm" (itoa (fix (+ 0.5 (float waagerecht))))) (cons "FARBE" (cond (farbe) ("RAL 7035"))) (cons "ANTRIEBSMOTOR" (cond (antriebsmotor) ("Europa 50 Hz"))) (cons "ANTRIEBSART" (kf-antriebsart (kf-daten))) (cons "MOVIMOT" (cond (movimot) ("0"))) (cons "STANDARD_STEUERUNG" (cond (steuerung) ("0"))) (cons "VERBINDUNGSELEMENTE" (cond (verbindung) ("Nein"))) (cons "ARTINR" (cond ((ssg-json-get variante "sivas_id")) (""))))) (ssg-id-generate kf-insert) ;; Reihenfolge: erst Drehung (entmod der Referenz), ZULETZT die XDATA (kf-rotation-setzen kf-insert rot-rad) (kf-xdata-schreiben kf-insert key) kf-insert) ;; Naechste freie KF-Nummer in der Zeichnung. ;; Nummer aus einem Blocknamen "KF_" (rein numerisch), sonst nil. Die ;; Bausteine der Kette heissen ebenfalls "KF_...": "KF_2D" (Draufsicht), ;; "KF_UM_26", "KF_LAENGE" duerfen NICHT als Nummer gelesen werden - atoi ;; liefert fuer "2D" naemlich 2 und fuer "UM_26" 0. Reiner Rechenkern. (defun kf-nummer-aus-name (nm / rest i ok) (setq nm (strcase nm)) (if (and (> (strlen nm) 3) (= (substr nm 1 3) "KF_")) (progn (setq rest (substr nm 4) i 1 ok T) (while (and ok (<= i (strlen rest))) (if (not (wcmatch (substr rest i 1) "#")) (setq ok nil)) (setq i (1+ i))) (if ok (atoi rest) nil)) nil)) ;; Erste freie Nummer ab start: ueberspringt jede Nummer, fuer die belegt-p ;; (Symbol einer Ein-Argument-Funktion) T liefert. Reiner Rechenkern, das ;; Praedikat macht die Zeichnungsabfrage austauschbar und damit testbar. (defun kf-freie-nummer (start belegt-p / n) (setq n start) (while (apply belegt-p (list n)) (setq n (1+ n))) n) ;; Ist die Block-DEFINITION KF_ ODER KF2D_ in der Zeichnung vorhanden? (defun kf-nummer-belegt-p (n) (not (null (or (tblsearch "BLOCK" (strcat "KF_" (itoa n))) (tblsearch "BLOCK" (strcat "KF2D_" (itoa n))))))) ;; Naechste freie KF-Nummer. Bewusst NICHT nur ueber die Referenzen im Modell: ;; loescht man einen Foerderer (oder baut KF_EDIT ihn neu auf), lebt seine ;; Block-DEFINITION in der Blocktabelle weiter. Wird deren Nummer erneut ;; vergeben, trifft das spaetere _.-BLOCK auf einen vorhandenen Namen - die ;; "Neu definieren?"-Abfrage verschluckt die Folge-Eingaben, der Block entsteht ;; nicht, und die Einzelteile bleiben LOSE im Modell liegen (Fehlerbild "Block ;; aufgeloest"). GF_n und VF_n pruefen aus demselben Grund die Blocktabelle. (defun kf-naechste-nummer ( / n ss i num) (setq n 0) (setq ss (ssget "X" '((0 . "INSERT") (2 . "KF_*")))) (if ss (progn (setq i 0) (while (< i (sslength ss)) (setq num (kf-nummer-aus-name (cdr (assoc 2 (entget (ssname ss i)))))) (if (and num (> num n)) (setq n num)) (setq i (1+ i))))) (kf-freie-nummer (1+ n) 'kf-nummer-belegt-p)) ;; ============================================================ ;; DIALOG ;; ============================================================ ;; Zustand zwischen den Aufrufen (Dialogstand bleibt je Sitzung erhalten). (if (not (boundp '*kf-dlg-variante*)) (setq *kf-dlg-variante* 0)) (if (not (boundp '*kf-dlg-variante-gesetzt*)) (setq *kf-dlg-variante-gesetzt* nil)) (if (not (boundp '*kf-dlg-hoehe*)) (setq *kf-dlg-hoehe* nil)) (if (not (boundp '*kf-dlg-verbindung*)) (setq *kf-dlg-verbindung* 0)) (if (not (boundp '*kf-dlg-farbe*)) (setq *kf-dlg-farbe* 0)) (if (not (boundp '*kf-dlg-antriebsmotor*)) (setq *kf-dlg-antriebsmotor* 0)) (if (not (boundp '*kf-dlg-movimot*)) (setq *kf-dlg-movimot* 0)) (if (not (boundp '*kf-dlg-steuerung*)) (setq *kf-dlg-steuerung* 0)) ;; ------------------------------------------------------------ ;; DCL-VORLAGE: Varianten als Radiobuttons ;; ------------------------------------------------------------ ;; DCL kann Tiles weder zur Laufzeit erzeugen noch radio_button-Labels per ;; set_tile aendern - der Varianten-Block wird darum an der Markerzeile ;; //@VARIANTEN@ eingesetzt (gleiches Vorgehen wie geruest_traeger.dcl). ;; Radiobuttons statt popup_list, weil es nur zwei Werte gibt und beide ohne ;; Aufklappen sichtbar sein sollen. (defun kf-radio-key (i) (strcat "v" (itoa i))) (defun kf-radio-index (key) (if (and key (> (strlen key) 1)) (atoi (substr key 2)) 0)) ;; Beschriftung einer Variante im Dialog: NUR der Winkel ("26 °"), nicht der ;; volle Variantenname - der Gruppenrahmen nennt bereits "Schraegfoerderer ;; Stahl Typ", der Name waere dort doppelt. Die Regelausfuehrung bekommt den ;; Zusatz "(Standard)". ;; ;; Welche Variante das ist, steht als "standard": true in der JSON und NICHT ;; im Code - sonst muesste bei einer Umstellung auf 30 Grad der Code ;; angefasst werden. Das Gradzeichen kommt als (chr 176) ueber einen ;; Platzhalter, damit die Sprachdatei ASCII bleibt (Projektkonvention). (defun kf-variante-standard-p (variante) (not (null (ssg-json-get variante "standard")))) (defun kf-variante-label (variante / w) (setq w (kf-zahl (ssg-json-get variante "winkel"))) (if w (ssg-textf (if (kf-variante-standard-p variante) "kf-variante-label-standard" "kf-variante-label") (list (itoa (fix (+ 0.5 w))) (chr 176))) (cond ((ssg-json-get variante "name")) ("")))) ;; Index der Standard-Variante (fuer die Vorauswahl beim ersten Aufruf); ;; 0, wenn keine als Standard markiert ist. (defun kf-standard-index (varianten / i treffer) (setq i 0 treffer nil) (foreach v varianten (if (and (null treffer) (kf-variante-standard-p v)) (setq treffer i)) (setq i (1+ i))) (cond (treffer) (0))) (defun kf-dcl-varianten-zeilen (varianten / i erg) (setq erg nil i 0) (foreach v varianten (setq erg (append erg (list (strcat " : radio_button { key = \"" (kf-radio-key i) "\"; label = \"" (kf-variante-label v) "\"; }")))) (setq i (1+ i))) erg) ;; Rueckgabe: Pfad der gefuellten temporaeren DCL-Datei oder nil. (defun kf-dcl-schreiben (varianten) (ssg-dcl-vorlage-fuellen (kf-dcl-pfad "kettenfoerderer.dcl") "kettenfoerderer" (list (cons "VARIANTEN" (kf-dcl-varianten-zeilen varianten))))) ;; ------------------------------------------------------------ ;; EINBAUHOEHE AUS ZWEI GEPICKTEN PUNKTEN ;; ------------------------------------------------------------ ;; Zweite Eingabeart neben dem Zahlenfeld: statt die Hoehe zu tippen, werden ;; zwei Punkte in der Zeichnung gewaehlt (z.B. Oberkante Zufuehrung und ;; Oberkante Abgabe) und ihr Hoehenunterschied uebernommen. ;; ;; Gemessen wird die Differenz in Z (die Hoehe der Punkte in der Zeichnung); die ;; Differenz in Y wird nur mit ausgegeben. ;; Damit nachvollziehbar bleibt, was gemessen wurde, nennt die Meldung BEIDE ;; Differenzen (dZ und dY): wer in einer DRAUFSICHT pickt, sieht sofort, dass ;; dort dZ = 0 ist, und kann es melden. ;; ;; Reiner Rechenkern (ohne Zeichnung testbar): nimmt zwei Punkte, liefert ;; (dz dy) als Betraege - die HOEHE zuerst. (defun kf-punkt-differenzen (p1 p2) (if (and p1 p2 (listp p1) (listp p2)) (list (abs (- (cond ((caddr p2)) (0.0)) (cond ((caddr p1)) (0.0)))) (abs (- (cadr p2) (cadr p1)))) nil)) ;; Zwei Punkte abfragen und die Hoehe daraus bestimmen. ;; Rueckgabe: Hoehe in mm, oder nil bei Abbruch. (defun kf-hoehe-aus-punkten ( / p1 p2 d) (setq p1 (getpoint (ssg-text "kf-prompt-messpunkt-1"))) (if (null p1) nil (progn (setq p2 (getpoint p1 (ssg-text "kf-prompt-messpunkt-2"))) (if (null p2) nil (progn (setq d (kf-punkt-differenzen p1 p2)) (princ (ssg-textf "kf-messung-ergebnis" (list (rtos (car d) 2 1) (rtos (cadr d) 2 1)))) (car d)))))) ;; Wert eines Auswahleintrags ("wert", sonst "name", sonst Vorgabe). ;; Gemeinsam genutzt von Dialog und Konsolen-Rueckfall. (defun kf-auswahl-wert (liste idx vorgabe / e) ;; BricsCAD: (nth idx nil) ist ein harter Fehler (AutoCAD liefert nil) - ;; fehlende Liste darum VOR dem nth abfangen (setq e (if liste (nth idx liste))) (cond ((null e) vorgabe) ((ssg-json-get e "wert")) ((ssg-json-get e "name")) (t vorgabe))) ;; Dialog zeigen - SCHLEIFE, bis OK oder Abbruch. Rueckgabe: ;; (variante hoehe verbindung farbe antriebsmotor movimot) ;; oder nil bei Abbruch. ;; ;; Die Schleife gibt es wegen der zweiten Hoehen-Eingabeart: der Knopf ;; "Hoehe messen" schliesst den Dialog (done_dialog 2), laesst zwei Punkte in ;; der Zeichnung waehlen und zeigt ihn mit dem gemessenen Wert erneut. Aus ;; einem action_tile heraus laesst sich kein getpoint aufrufen - dasselbe ;; Vorgehen wie beim Speichern/Loeschen im Geruest-Dialog (done_dialog 2/3). ;; ;; Die Laengenvorschau unter dem Hoehenfeld gab es zwischenzeitlich; sie ist ;; auf Nutzerwunsch wieder entfallen. Ein nicht baubarer Wert wird darum erst ;; nach OK gemeldet (alert in c:KETTENFOERDERER). (defun kf-dialog (daten / varianten verbindungen farben motoren movimots steuerungen idx ergebnis gemessen) (setq varianten (ssg-json-get daten "varianten") verbindungen (ssg-json-get daten "verbindungselemente") farben (ssg-json-get daten "farbe") motoren (ssg-json-get daten "antriebsmotor") movimots (ssg-json-get daten "movimot") steuerungen (ssg-json-get daten "standard_steuerung")) (if (null *kf-dlg-hoehe*) (setq *kf-dlg-hoehe* (cond ((kf-zahl (ssg-json-get (ssg-json-get daten "einbauhoehe") "vorgabe"))) (1500.0)))) ;; Beim ERSTEN Aufruf je Sitzung die Regelausfuehrung vorwaehlen; danach ;; bleibt die zuletzt getroffene Wahl stehen. (if (null *kf-dlg-variante-gesetzt*) (progn (setq *kf-dlg-variante* (kf-standard-index varianten)) (setq *kf-dlg-variante-gesetzt* T))) (setq idx 2) (while (= idx 2) (setq idx (kf-dialog-zeigen daten varianten verbindungen farben motoren movimots steuerungen)) (if (= idx 2) (progn (setq gemessen (kf-hoehe-aus-punkten)) (if gemessen (setq *kf-dlg-hoehe* gemessen)))) ) (if (= idx 1) (list (nth *kf-dlg-variante* varianten) *kf-dlg-hoehe* (kf-auswahl-wert verbindungen *kf-dlg-verbindung* "Nein") (kf-auswahl-wert farben *kf-dlg-farbe* "RAL 7035") (kf-auswahl-wert motoren *kf-dlg-antriebsmotor* "Europa 50 Hz") (kf-auswahl-wert movimots *kf-dlg-movimot* "0") (kf-auswahl-wert steuerungen *kf-dlg-steuerung* "0")) nil)) ;; Den Dialog EINMAL zeigen. Rueckgabe: 1 = OK, 0 = Abbruch, 2 = "Hoehe ;; messen" (der Aufrufer pickt dann zwei Punkte und ruft erneut auf). (defun kf-dialog-zeigen (daten varianten verbindungen farben motoren movimots steuerungen / dcl-pfad dcl-id idx vb-namen fa-namen nz-namen mm-namen st-namen) (setq vb-namen (mapcar '(lambda (v) (cond ((ssg-json-get v "name")) (""))) verbindungen)) (setq fa-namen (mapcar '(lambda (v) (cond ((ssg-json-get v "name")) (""))) farben)) (setq nz-namen (mapcar '(lambda (v) (cond ((ssg-json-get v "name")) (""))) motoren)) (setq mm-namen (mapcar '(lambda (v) (cond ((ssg-json-get v "name")) (""))) movimots)) (setq st-namen (mapcar '(lambda (v) (cond ((ssg-json-get v "name")) (""))) steuerungen)) ;; Vorlage mit den Varianten-Radiobuttons fuellen (Temp-Datei) (setq dcl-pfad (kf-dcl-schreiben varianten)) (if (not dcl-pfad) (progn (alert (ssg-text "kf-fehler-dcl")) 0) (progn (setq dcl-id (load_dialog dcl-pfad)) (if (not (new_dialog "kettenfoerderer" dcl-id)) (progn (unload_dialog dcl-id) (vl-file-delete dcl-pfad) (alert (ssg-text "kf-fehler-dcl")) 0) (progn (start_list "verbindung") (mapcar 'add_list vb-namen) (end_list) (start_list "farbe") (mapcar 'add_list fa-namen) (end_list) (start_list "antriebsmotor") (mapcar 'add_list nz-namen) (end_list) (start_list "movimot") (mapcar 'add_list mm-namen) (end_list) (start_list "standard_steuerung") (mapcar 'add_list st-namen) (end_list) ;; Radiobuttons: der gewaehlte Button wird einzeln gesetzt, nicht ;; die Gruppe - set_tile auf den Gruppenschluessel waehlt nicht aus. (if (>= *kf-dlg-variante* (length varianten)) (setq *kf-dlg-variante* 0)) (set_tile (kf-radio-key *kf-dlg-variante*) "1") (set_tile "verbindung" (itoa *kf-dlg-verbindung*)) (set_tile "farbe" (itoa *kf-dlg-farbe*)) (set_tile "antriebsmotor" (itoa *kf-dlg-antriebsmotor*)) (set_tile "movimot" (itoa *kf-dlg-movimot*)) (set_tile "standard_steuerung" (itoa *kf-dlg-steuerung*)) (set_tile "hoehe" (rtos *kf-dlg-hoehe* 2 0)) ;; Merkmal 357: Dropdown mit einer einzigen Option, immer gewaehlt (start_list "antriebsart") (mapcar 'add_list (mapcar '(lambda (v) (cond ((ssg-json-get v "name")) (""))) (ssg-json-get daten "antriebsart"))) (end_list) (set_tile "antriebsart" "0") ;; Die Radiobutton-Gruppe meldet den KEY des gewaehlten Buttons ;; ("v0"/"v1"), nicht dessen Index - daher kf-radio-index. (action_tile "variante" "(setq *kf-dlg-variante* (kf-radio-index $value))") (action_tile "hoehe" "(setq *kf-dlg-hoehe* (atof $value))") (action_tile "verbindung" "(setq *kf-dlg-verbindung* (atoi $value))") (action_tile "farbe" "(setq *kf-dlg-farbe* (atoi $value))") (action_tile "antriebsmotor" "(setq *kf-dlg-antriebsmotor* (atoi $value))") (action_tile "movimot" "(setq *kf-dlg-movimot* (atoi $value))") (action_tile "standard_steuerung" "(setq *kf-dlg-steuerung* (atoi $value))") ;; Zweite Hoehen-Eingabeart: Dialog schliessen, der Aufrufer laesst ;; zwei Punkte waehlen und zeigt ihn danach erneut. (action_tile "hoehe_messen" "(done_dialog 2)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq idx (start_dialog)) (unload_dialog dcl-id) (vl-file-delete dcl-pfad) idx))))) ;; DCL-Pfad aufloesen: DXFM_DCL, sonst dcl/ unter der Projektwurzel. ;; Gleiches Vorgehen wie geruest-dcl-pfad (GeruestInsert.lsp) - bewusst eine ;; eigene kurze Funktion statt eines Zugriffs quer ins Geruest-Modul, damit ;; dieses Modul ohne GeruestInsert ladbar bleibt. (defun kf-dcl-pfad (datei / basis) (setq basis (cond ((getenv "DXFM_DCL")) ((strcat (getenv "DXFMAKRO") "/dcl")))) (if (and basis (/= basis "")) (findfile (strcat basis "/" datei)) nil)) ;; ============================================================ ;; KONSOLEN-RUECKFALL (ohne GUI, fuer automatische Tests) ;; ============================================================ ;; Eine Auswahlliste auf der Konsole abfragen. Rueckgabe: 0-basierter Index ;; (bei ungueltiger Eingabe bleibt die Vorgabe stehen). Alle vier Auswahlen ;; laufen hierueber - vorher stand derselbe Block viermal untereinander. (defun kf-konsole-wahl (liste header-key prompt-key vorgabe-idx / i v antwort) (princ (ssg-text header-key)) (setq i 1) (foreach v liste (princ (ssg-textf "kf-konsole-option" (list (itoa i) (ssg-json-get v "name")))) (setq i (1+ i))) (setq antwort (ssg-in-int (ssg-text prompt-key) (1+ vorgabe-idx))) (if (or (null antwort) (< antwort 1) (> antwort (length liste))) vorgabe-idx (1- antwort))) (defun kf-konsole (daten / varianten verbindungen farben motoren movimots steuerungen hoehe) (setq varianten (ssg-json-get daten "varianten") verbindungen (ssg-json-get daten "verbindungselemente") farben (ssg-json-get daten "farbe") motoren (ssg-json-get daten "antriebsmotor") movimots (ssg-json-get daten "movimot") steuerungen (ssg-json-get daten "standard_steuerung")) (setq *kf-dlg-variante* (kf-konsole-wahl varianten "kf-konsole-variante-header" "kf-konsole-variante-prompt" *kf-dlg-variante*)) ;; Hoehe: Zahl tippen ODER 0 eingeben und zwei Punkte messen (zweite ;; Eingabeart, entspricht dem Knopf im Dialog). (princ (ssg-text "kf-konsole-hoehe-hinweis")) (setq hoehe (ssg-in-real (ssg-text "kf-konsole-hoehe-prompt") (cond (*kf-dlg-hoehe*) (1500.0)))) (if (and hoehe (<= hoehe 0.0)) (setq hoehe (kf-hoehe-aus-punkten))) (if (null hoehe) (setq hoehe (cond (*kf-dlg-hoehe*) (1500.0)))) (setq *kf-dlg-hoehe* hoehe) ;; Reihenfolge wie im Dialog und im Sivas-Merkmalstamm: 361 vor 354. (setq *kf-dlg-steuerung* (kf-konsole-wahl steuerungen "kf-konsole-steuerung-header" "kf-konsole-steuerung-prompt" *kf-dlg-steuerung*)) (setq *kf-dlg-farbe* (kf-konsole-wahl farben "kf-konsole-farbe-header" "kf-konsole-farbe-prompt" *kf-dlg-farbe*)) (setq *kf-dlg-antriebsmotor* (kf-konsole-wahl motoren "kf-konsole-antriebsmotor-header" "kf-konsole-antriebsmotor-prompt" *kf-dlg-antriebsmotor*)) (setq *kf-dlg-movimot* (kf-konsole-wahl movimots "kf-konsole-movimot-header" "kf-konsole-movimot-prompt" *kf-dlg-movimot*)) (setq *kf-dlg-verbindung* (kf-konsole-wahl verbindungen "kf-konsole-verbindung-header" "kf-konsole-verbindung-prompt" *kf-dlg-verbindung*)) (list (nth *kf-dlg-variante* varianten) hoehe (kf-auswahl-wert verbindungen *kf-dlg-verbindung* "Nein") (kf-auswahl-wert farben *kf-dlg-farbe* "RAL 7035") (kf-auswahl-wert motoren *kf-dlg-antriebsmotor* "Europa 50 Hz") (kf-auswahl-wert movimots *kf-dlg-movimot* "0") (kf-auswahl-wert steuerungen *kf-dlg-steuerung* "0"))) ;; ============================================================ ;; KF_BAUEN - gemeinsamer Bau fuer Befehl und Edit ;; ============================================================ ;; Baut Hauptblock KF_ (Seitenansicht mit Beschriftung + Hoehenmass) und ;; danach den Hilfsblock KF2D_ (Draufsicht). Beide Bloecke werden ungedreht ;; gebaut; eine Drehung (Edit eines von Hand gedrehten Blocks) setzt ;; kf-rotation-setzen danach wieder auf. ;; eingabe = Ergebnis von kf-dialog/kf-konsole (Variante, Hoehe, ...) ;; startpunkt = KS_EIN der Umlenkstation (Einfuegepunkt Hauptblock) ;; rot-rad = Drehung des Hauptblocks, hilfs-pt/hilfs-rot = Lage des Hilfsblocks ;; key = Schluessel Haupt <-> Hilfsblock (nil -> neuer) ;; Rueckgabe: Liste (Blockname Hoehe Laenge) bei Erfolg, sonst nil (die ;; Fehlermeldung ist dann schon ausgegeben, die Zeichnung unveraendert). (defun kf-bauen (daten eingabe startpunkt rot-rad hilfs-pt hilfs-rot key loeschen / variante hoehe verbindung farbe antriebsmotor movimot steuerung geo erg laenge skala lmin lmax endpunkt waagerecht last-ent kf-nummer winkel-str) (setq variante (nth 0 eingabe) hoehe (nth 1 eingabe) verbindung (nth 2 eingabe) farbe (nth 3 eingabe) antriebsmotor (nth 4 eingabe) movimot (nth 5 eingabe) steuerung (nth 6 eingabe)) (setq lmin (kf-zahl (ssg-json-get (ssg-json-get daten "laenge") "min")) lmax (kf-zahl (ssg-json-get (ssg-json-get daten "laenge") "max"))) (setq geo (kf-geometrie-messen variante)) (setq erg (kf-laenge-fuer-hoehe geo hoehe lmin lmax)) (cond ((caddr erg) (if (ssg-gui-p) (alert (ssg-text (caddr erg)))) (princ (ssg-text (caddr erg))) nil) (t (setq laenge (car erg) skala (cadr erg)) (ssg-start "Kettenfoerderer" '(("OSMODE") ("ATTREQ") ("ATTDIA"))) (setvar "OSMODE" 0) (setvar "ATTREQ" 0) (setvar "ATTDIA" 0) ;; Edit: alte Bloecke (Liste von Enames) erst jetzt loeschen (foreach e loeschen (if e (entdel e))) (if (null key) (setq key (kf-neuer-key))) (setq last-ent (ssg-lastent-ohne-attribute)) (setq kf-nummer (kf-naechste-nummer)) (setq winkel-str (kf-winkel-text variante)) (setq endpunkt (kf-kette-bauen variante geo skala startpunkt)) (setq waagerecht (kf-waagerecht-laenge startpunkt endpunkt 0.0)) (kf-block-erstellen variante geo hoehe waagerecht verbindung startpunkt endpunkt last-ent kf-nummer farbe antriebsmotor movimot steuerung key rot-rad) (kf-hilfsblock-bauen daten kf-nummer key winkel-str hoehe waagerecht hilfs-pt hilfs-rot) (ssg-end) (list (strcat "KF_" (itoa kf-nummer)) hoehe laenge)))) ;; ============================================================ ;; C:KETTENFOERDERER - Hauptbefehl ;; ============================================================ (defun c:KETTENFOERDERER ( / daten eingabe startpunkt erg t0) ;; Laufzeit des Dialogaufbaus protokollieren (Schalter "kf-zeit", siehe ;; ssg_dbg.lsp): unterscheidet Lazy-Laden, JSON-Lesen und Dialogaufbau. (setq t0 (getvar "MILLISECS")) (setq daten (kf-daten)) (kf-zeit "Daten geladen" t0) (if (null daten) (princ (ssg-text "kf-fehler-daten-leer")) (progn (kf-zeit "vor Dialog" t0) (setq eingabe (if (ssg-gui-p) (kf-dialog daten) (kf-konsole daten))) (if (null eingabe) (princ (ssg-text "kf-abgebrochen")) (progn (setq startpunkt (getpoint (ssg-text "kf-prompt-startpunkt"))) (if (null startpunkt) (princ (ssg-text "kf-abgebrochen")) (progn ;; Hilfsblock beim ersten Mal 1000 mm unter dem Hauptblock (setq erg (kf-bauen daten eingabe startpunkt 0.0 (kf-versatzpunkt startpunkt (kf-hilfsblock-versatz daten)) 0.0 nil nil)) (if erg (princ (ssg-textf "kf-fertig" (list (car erg) (rtos (float (cadr erg)) 2 0) (rtos (caddr erg) 2 0))))))))))) (princ)) ;; ============================================================ ;; C:KF_EDIT - Doppelklick auf einen KF_n-Block ;; ============================================================ ;; Zeigt den Dialog mit den Werten des gewaehlten Blocks und baut ihn nach OK ;; an SEINER Stelle neu auf. Vorbild: GEFAELLESTRECKE_EDIT. ;; ;; Einfuegepunkt und Drehung kommen aus dem Block selbst (Gruppencode 10 und ;; 50), alles Uebrige steht in den Attributen. Ein von Hand verschobener oder ;; gedrehter Block wird dadurch an seiner NEUEN Lage neu gebaut. Die XDATA ;; traegt nur den Schluessel zum Hilfsblock KF2D_: er wird mit dem Hauptblock ;; neu erzeugt (auch wenn der Benutzer ihn geloescht hatte) und behaelt die ;; Lage, an die der Benutzer ihn zuletzt gelegt hat. ;; ;; Der alte Block wird erst geloescht, wenn der Benutzer den Dialog mit OK ;; bestaetigt hat - ein Abbruch laesst die Zeichnung unveraendert. ;; Dialogzustand aus den Attributen eines Blocks vorbelegen. Sucht je ;; Auswahlliste den Index, dessen "wert" zum Attributwert passt; ein ;; unbekannter Wert (von Hand editiert) laesst die Vorgabe stehen, statt den ;; Dialog scheitern zu lassen. (defun kf-index-fuer-wert (liste wert vorgabe / i treffer) (setq i 0 treffer nil) (foreach e liste (if (and (null treffer) wert (equal (ssg-json-get e "wert") wert)) (setq treffer i)) (setq i (1+ i))) (cond (treffer) (vorgabe))) (defun kf-dlg-aus-attributen (daten attribs / w v) (setq w (cdr (assoc "WINKEL" attribs))) (if w (progn (setq v (kf-variante-finden (atof w) (ssg-json-get daten "varianten"))) (if v (setq *kf-dlg-variante* (kf-tag-index-liste v (ssg-json-get daten "varianten")))))) (setq w (cdr (assoc "H_EINBAUHOEHE_mm" attribs))) (if (and w (/= w "")) (setq *kf-dlg-hoehe* (atof w))) (setq *kf-dlg-farbe* (kf-index-fuer-wert (ssg-json-get daten "farbe") (cdr (assoc "FARBE" attribs)) *kf-dlg-farbe*)) (setq *kf-dlg-antriebsmotor* (kf-index-fuer-wert (ssg-json-get daten "antriebsmotor") (cdr (assoc "ANTRIEBSMOTOR" attribs)) *kf-dlg-antriebsmotor*)) (setq *kf-dlg-movimot* (kf-index-fuer-wert (ssg-json-get daten "movimot") (cdr (assoc "MOVIMOT" attribs)) *kf-dlg-movimot*)) (setq *kf-dlg-steuerung* (kf-index-fuer-wert (ssg-json-get daten "standard_steuerung") (cdr (assoc "STANDARD_STEUERUNG" attribs)) *kf-dlg-steuerung*)) (setq *kf-dlg-verbindung* (kf-index-fuer-wert (ssg-json-get daten "verbindungselemente") (cdr (assoc "VERBINDUNGSELEMENTE" attribs)) *kf-dlg-verbindung*)) ;; Die Variante wurde eben aus dem Block gesetzt - die Standard-Vorauswahl ;; darf sie nicht mehr ueberschreiben. (setq *kf-dlg-variante-gesetzt* T) (princ)) ;; Position eines Eintrags in einer Liste (0-basiert), 0 wenn nicht gefunden. (defun kf-tag-index-liste (eintrag liste / i treffer) (setq i 0 treffer nil) (foreach e liste (if (and (null treffer) (equal e eintrag)) (setq treffer i)) (setq i (1+ i))) (cond (treffer) (0))) (defun c:KF_EDIT ( / ss ent ed bname attribs daten eingabe startpunkt rot-rad key hilfs hilfs-pt hilfs-rot erg) ;; Erst die VORGEWAEHLTE Auswahl (Doppelklick setzt sie), nur ohne sie per ;; Klick nachfragen - wie GEFAELLESTRECKE_EDIT/KreiselEdit. (setq ss (ssget "I")) (setq ent (if (and ss (= (sslength ss) 1)) (ssname ss 0) (car (entsel (ssg-text "kf-edit-waehlen"))))) (if (null ent) (princ (ssg-text "kf-abgebrochen")) (progn (setq ed (entget ent)) (setq bname (cdr (assoc 2 ed))) ;; Nur echte Foerderer "KF_": die Bausteine (KF_UM_26, KF_2D, ...) ;; tragen ebenfalls das Praefix KF_, haben aber keine Attribute. (if (or (/= (cdr (assoc 0 ed)) "INSERT") (null (kf-nummer-aus-name bname))) (alert (ssg-text "kf-edit-kein-kf")) (progn (setq daten (kf-daten)) (if (null daten) (princ (ssg-text "kf-fehler-daten-leer")) (progn (setq attribs (ssg-attrib-read ent)) (setq startpunkt (cdr (assoc 10 ed))) (setq rot-rad (cond ((cdr (assoc 50 ed))) (0.0))) ;; Schluessel zum Hilfsblock; Altbestand ohne Schluessel -> nil, ;; dann gibt es keinen auffindbaren Hilfsblock und ein neuer ;; entsteht an der Standardposition. (setq key (kf-xdata-key ent)) (setq hilfs (kf-hilfsblock-finden key)) (if hilfs (setq hilfs-pt (cdr (assoc 10 (entget hilfs))) hilfs-rot (cond ((cdr (assoc 50 (entget hilfs)))) (0.0))) (setq hilfs-pt (kf-versatzpunkt startpunkt (kf-hilfsblock-versatz daten)) hilfs-rot 0.0)) (kf-dlg-aus-attributen daten attribs) (setq eingabe (if (ssg-gui-p) (kf-dialog daten) (kf-konsole daten))) (if (null eingabe) (princ (ssg-text "kf-abgebrochen")) (progn ;; Der Hilfsblock wird bei JEDEM Edit neu erzeugt, damit er ;; zur neuen Hoehe/Laenge passt - an der Stelle, an der der ;; Benutzer ihn zuletzt hingelegt hat. (setq erg (kf-bauen daten eingabe startpunkt rot-rad hilfs-pt hilfs-rot (cond (key) (kf-neuer-key)) (list ent hilfs))) (if erg (princ (ssg-textf "kf-edit-fertig" (list bname (car erg))))))))))))) (princ)) ;; ============================================================ ;; C:KF_KS_PRUEFEN - Diagnose ;; ============================================================ ;; Liest fuer jede Variante die KS-Lage aller drei Bloecke aus und gibt sie ;; aus: Ursprung und Richtung von KS_EIN/KS_AUS, daraus die abgeleiteten ;; Einbauwinkel und Hoehenbeitraege. Erste Anlaufstelle, wenn eine Kette ;; nicht zusammenpasst - zeigt sofort, ob ein Block kein KS_EIN/KS_AUS hat ;; oder ob seine Achsen anders liegen als erwartet. (defun c:KF_KS_PRUEFEN ( / daten varianten geo b) (setq daten (kf-daten)) (if (null daten) (princ (ssg-text "kf-fehler-daten-leer")) (progn (setq varianten (ssg-json-get daten "varianten")) (princ (ssg-text "kf-pruef-kopf")) (foreach v varianten (princ (ssg-textf "kf-pruef-variante" (list (ssg-json-get v "name")))) (foreach feld '("block_umlenkung" "block_laenge" "block_antrieb") (setq b (ssg-json-get v feld)) (kf-pruef-block b)) (setq geo (kf-geometrie-messen v)) (if (cdr (assoc "fehler" geo)) (princ (ssg-textf "kf-pruef-fehler" (list (ssg-text (cdr (assoc "fehler" geo)))))) (princ (ssg-textf "kf-pruef-geo" (list (rtos (cdr (assoc "hz-um" geo)) 2 2) (rtos (cdr (assoc "hz-l" geo)) 2 2) (rtos (cdr (assoc "hz-an" geo)) 2 2) (rtos (cdr (assoc "dy-um" geo)) 2 2) (rtos (cdr (assoc "dy-an" geo)) 2 2) (rtos (cdr (assoc "dx-l" geo)) 2 2) (rtos (cdr (assoc "dy-l" geo)) 2 2)))))))) (princ)) ;; Einen Block vermessen und protokollieren (Helfer von KF_KS_PRUEFEN). (defun kf-pruef-block (blockname / ks ein aus) (if (null (kf-block-laden blockname)) (princ (ssg-textf "kf-pruef-block-fehlt" (list blockname))) (progn (setq ks (ks-block-messen blockname)) (setq ein (cadr (assoc "KS_EIN" ks)) aus (cadr (assoc "KS_AUS" ks))) (if (not (and ein aus)) (princ (ssg-textf "kf-pruef-ks-fehlt" (list blockname (if ein (ssg-text "kf-pruef-ja") (ssg-text "kf-pruef-nein")) (if aus (ssg-text "kf-pruef-ja") (ssg-text "kf-pruef-nein"))))) (princ (ssg-textf "kf-pruef-block" (list blockname (rtos (car (car ein)) 2 2) (rtos (cadr (car ein)) 2 2) (cond ((rtos (ks-xy-winkel ein) 2 2)) ("-")) (rtos (car (car aus)) 2 2) (rtos (cadr (car aus)) 2 2) (cond ((rtos (ks-xy-winkel aus) 2 2)) ("-"))))))))) (setq *ssg-KettenFoerderer-loaded* T) (princ "\n>>> KettenFoerderer.lsp geladen (KETTENFOERDERER, KF_KS_PRUEFEN)") (princ)