Schoenenberger_Systeme_GmbH/dxfmakros
7
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
503b02a005dcc6cc37545231974765e3fb5b53c5
dxfmakros/Lisp/KettenFoerderer.lsp
T
y.wang 503b02a005 refactor: Kettenfoerderer als Seitenansicht mit Beschriftung und Hoehenmass, Draufsicht als eigener Hilfsblock KF2D_n 
- Hauptblock KF_n: flache, ungedrehte Seitenansicht mit Beschriftung und Hoehenmass; nur er wird exportiert
- Draufsicht KF_2D als getrennter Hilfsblock KF2D_n (projizierte Laenge, frei verschiebbar, per KF_EDIT regenerierbar), Verknuepfung ueber XDATA-Schluessel
- L_KF_mm = waagerechte Laenge, Sivas-Zeile ohne Laenge, Export nur KF_<Ziffern>
- ensure-block-loaded: Block ohne ILS-Datei (KF_2D) nicht mehr als fehlend melden
- Layer kettenfoerderer_beschriftung, Dispatcher-Zweig KF2D_*, Sprachdateien und Unit-Tests angepasst

Co-Authored-By: Claude Sonnet 5.5 <noreply@anthropic.com>
2026-10-30 15:42:58 +01:00

1348 lines
64 KiB
Common Lisp
Raw Blame History

;; ============================================================
;; KETTENFOERDERER.LSP - Schraegfoerderer Stahl (Omniflo)
;; ============================================================
;; Baut aus drei vorhandenen Bloecken eine Kette zusammen und fasst sie zu
;; EINEM Block KF_<n> zusammen - dasselbe Muster wie KREISEL_n/VF_n/GF_n:
;;
;; KF_UM_<winkel> (Umlenkstation, unten)
;; KS_AUS --> KS_EIN
;; KF_LAENGE (Zwischenstueck, in X SKALIERT - wie die Staustrecke
;; beim VarioFoerderer)
;; KS_AUS --> KS_EIN
;; KF_AN_<winkel> (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_<n> 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_<n> (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_<n> 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/<Dimension>/).
;; ============================================================
(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 <symbol>) - 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_<n>, 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/<Dimension>/)
;; ============================================================
;; 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/<dim>/ 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_<n>) und Hilfsblock (KF2D_<n>) 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_<n> (Draufsicht)
;; ============================================================
;; Die Draufsicht KF_2D ist KEIN Teil des Foerderers, sondern ein
;; Hilfsblock, an dem der Benutzer Schienen anschliesst. Darum:
;; - eigener Block KF2D_<n> (nicht KF_*): die Export-Muster erfassen ihn nicht,
;; exportiert wird nur der Hauptblock KF_<n>
;; - 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_<n> 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_<n>" (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_<n> ODER KF2D_<n> 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_<n> (Seitenansicht mit Beschriftung + Hoehenmass) und
;; danach den Hilfsblock KF2D_<n> (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_<n>: 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_<n>": 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)
Reference in New Issue View Git Blame Copy Permalink