Schoenenberger_Systeme_GmbH/dxfmakros
7
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
master
dxfmakros/Lisp/KettenFoerderer.lsp
T
y.wang f8b8a4175b fix: KF_EDIT baute gedrehte Foerderer ungedreht neu 
Der Drehwinkel wird beim Bau in die Geometrie eingerechnet, die Blockreferenz
selbst hat immer Drehung 0 (ssg-block-wrap-welt). KF_EDIT las die Drehung nur
aus Gruppencode 50 und baute einen mit z.B. 90 Grad gebauten Foerderer beim
Bearbeiten daher ungedreht neu.

Der gebaute Winkel steht jetzt als XDATA (SSG_KF_EDIT) am Block. KF_EDIT
addiert eine spaeter von Hand vorgenommene Drehung der Referenz
(Gruppencode 50); Altbestand ohne XDATA verhaelt sich wie bisher.

- kf-block-erstellen: neuer Parameter drehung, beide Aufrufer angepasst
- reiner Kern kf-drehung-gesamt (auf -180..180 normalisiert) mit Unit-Tests

Co-Authored-By: Claude Sonnet 5.5 <noreply@anthropic.com>
2026-10-23 15:43:36 +02:00

1205 lines
58 KiB
Common Lisp
Raw Permalink 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.
;;
;; 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 - Laenge des skalierten Zwischenstuecks, CSV-Spalte
;; 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)
;; ============================================================
;; AUFRICHTUNG: die Baugruppe steht im Modell
;; ============================================================
;; Die Bausteine sind in der XY-Ebene gezeichnet (X = Fahrtrichtung,
;; Y = Hoehe) - eine Seitenansicht. Eingebaut werden sie AUFGERICHTET: um
;; 90 Grad um die Fahrtrichtungsachse gekippt, sodass die Hoehe nach Z
;; wandert. Von oben sieht man dann die Draufsicht KF_2D, von der Seite die
;; Kette; beide bilden EIN Objekt ohne Versatz.
;;
;; Gesamtdrehung je Baustein: Rz(basis) * Rx(90) * Rz(eigen)
;; Rz(eigen) richtet den Baustein in seiner EIGENEN Zeichenebene aus
;; (der aus den KS gemessene Verkettungswinkel, s. kf-hz-folge)
;; Rx(90) richtet die Ebene auf - Y_lokal wird zu Z_welt
;; Rz(basis) dreht die fertige Baugruppe in der Draufsicht
;; Die Reihenfolge ist nicht beliebig: Rz(eigen) muss VOR dem Aufrichten
;; wirken (es ist eine Drehung in der Blockebene), Rz(basis) danach (es ist
;; eine Drehung im Modell).
(defun kf-matrix-aufrecht (basis-hz eigen-hz)
(mat3-mul-mat3 (ks-rot-z basis-hz)
(mat3-mul-mat3 (ks-rot-x 90.0) (ks-rot-z eigen-hz))))
;; ============================================================
;; 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 (aufgerichtet, 3D)
;; ============================================================
;; Fuegt die drei Bausteine ab startpunkt verkettet ein - AUFGERICHTET, die
;; Hoehe laeuft also in Z (siehe kf-matrix-aufrecht). basis-hz dreht die
;; fertige Baugruppe in der Draufsicht.
;; Rueckgabe: Weltpunkt des KS_AUS der Antriebsstation (Kettenende).
(defun kf-kette-bauen (variante geo skala startpunkt basis-hz / pt)
(setq pt startpunkt)
(setq pt (insert-block-ks-matrix
(ssg-json-get variante "block_umlenkung")
pt
(kf-matrix-aufrecht basis-hz (cdr (assoc "hz-um" geo)))
1.0))
(setq pt (insert-block-ks-matrix
(ssg-json-get variante "block_laenge")
pt
(kf-matrix-aufrecht basis-hz (cdr (assoc "hz-l" geo)))
skala))
(setq pt (insert-block-ks-matrix
(ssg-json-get variante "block_antrieb")
pt
(kf-matrix-aufrecht basis-hz (cdr (assoc "hz-an" geo)))
1.0))
pt)
;; ------------------------------------------------------------
;; DRAUFSICHT (KF_2D) - deckungsgleich mit der Kette
;; ------------------------------------------------------------
;; KF_2D gehoert in DIESELBE Lage wie die Kette, nicht daneben: sein KS_EIN
;; faellt mit KS_EIN der Umlenkung zusammen, sein KS_AUS mit KS_AUS des
;; Antriebs. Dadurch ist die Baugruppe EIN Koerper - von oben sieht man die
;; Draufsicht, von der Seite die Kette.
;;
;; Zwischenzeitlich lagen beide Ansichten 1000 mm uebereinander (versatz_y).
;; Das war eine Hilfskonstruktion, solange die Kette flach in der XY-Ebene
;; lag; seit sie aufgerichtet eingebaut wird, ist sie unnoetig.
;;
;; KF_2D ist selbst flach gezeichnet und wird darum NICHT aufgerichtet,
;; sondern nur um die Steigung GENEIGT (Rz(basis) * Ry(-winkel)) und auf die
;; SCHRAEGLAENGE skaliert. In der Draufsicht erscheint es dadurch genau mit
;; der Grundrisslaenge - die Verkuerzung uebernimmt die Projektion, sie muss
;; nicht gerechnet werden.
;; Neigungswinkel und Schraeglaenge aus Start- und Endpunkt der Kette.
;; Rueckgabe: (schraeglaenge winkel-grad), oder nil bei Laenge 0.
;; Reiner Rechenkern - der eigentliche Pruefpunkt der 3D-Umstellung.
(defun kf-neigung-aus-punkten (p1 p2 basis-hz / rad dx dy dz horiz laenge)
(setq rad (* (float basis-hz) (/ pi 180.0)))
(setq dx (- (car p2) (car p1))
dy (- (cadr p2) (cadr p1))
dz (- (cond ((caddr p2)) (0.0)) (cond ((caddr p1)) (0.0))))
;; Horizontalanteil auf die Kettenrichtung projiziert (nicht die blosse
;; X-Differenz) - sonst stimmt es bei gedreht eingefuegter Kette nicht.
(setq horiz (+ (* dx (cos rad)) (* dy (sin rad))))
(setq laenge (sqrt (+ (* horiz horiz) (* dz dz))))
(if (< laenge 1e-6)
nil
(list laenge (/ (* 180.0 (atan dz horiz)) pi))))
;; Draufsicht einfuegen - deckungsgleich mit der Kette.
;; kette-start/kette-ende = KS_EIN der Umlenkung bzw. KS_AUS des Antriebs.
;; Rueckgabe: die verwendete Schraeglaenge (mm), sonst nil.
(defun kf-ansicht-2d-bauen (daten kette-start kette-ende basis-hz /
cfg bname masse laenge winkel ks ein-dx skala R)
(setq cfg (ssg-json-get daten "ansicht_2d"))
(setq bname (if cfg (ssg-json-get cfg "block")))
(if (or (null bname) (= bname ""))
nil
(progn
(setq masse (kf-neigung-aus-punkten kette-start kette-ende basis-hz))
(if (null masse)
(progn (princ (ssg-text "kf-2d-laenge-null")) nil)
(progn
(setq laenge (car masse) winkel (cadr masse))
(if (null (kf-block-laden bname))
(progn (princ (ssg-textf "kf-fehler-block-datei" (list bname))) nil)
(progn
(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 laenge ein-dx))
(if (null skala)
(progn (princ (ssg-textf "kf-2d-ks-fehlt" (list bname))) nil)
(progn
;; Ry(-winkel) hebt die flache Scheibe um die Steigung an;
;; das Vorzeichen folgt der Rechte-Hand-Regel (positives dz
;; = Drehung gegen den Uhrzeigersinn um die Y-Achse).
(setq R (mat3-mul-mat3 (ks-rot-z basis-hz)
(ks-rot-y (- winkel))))
(insert-block-ks-matrix bname kette-start R skala)
(princ (ssg-textf "kf-2d-gebaut"
(list bname (rtos laenge 2 0) (rtos winkel 2 1))))
laenge)))))))))
;; ============================================================
;; DREHWINKEL DES BLOCKS (XDATA)
;; ============================================================
;; Der Drehwinkel der Baugruppe wird beim Bau in die GEOMETRIE eingerechnet
;; (kf-matrix-aufrecht), nicht ueber die Drehung der Blockreferenz:
;; ssg-block-wrap-welt fuegt den fertigen Block immer mit Drehung 0 ein. Die
;; Referenz traegt damit nirgends mehr, wie die Kette gedreht wurde - KF_EDIT
;; wuerde sie beim Neuaufbau ungedreht neu bauen. Darum steht der Winkel als
;; XDATA am Block (Projektregel: Editierdaten gehoeren in XDATA, nicht in
;; .dbg). Eine spaetere Drehung der Referenz von Hand kommt ueber
;; Gruppencode 50 hinzu und wird addiert.
(setq *kf-xdata-app* "SSG_KF_EDIT")
;; Gesamtdrehung = gebauter Winkel (XDATA, Grad) + Drehung der Referenz
;; (Gruppencode 50, Bogenmass), auf -180..180 Grad normalisiert. Reiner
;; Rechenkern; fehlende Werte zaehlen als 0 (Altbestand ohne XDATA).
(defun kf-drehung-gesamt (xdata-grad dxf50-rad / g r)
(setq g (cond (xdata-grad (float xdata-grad)) (0.0)))
(setq r (cond (dxf50-rad (float dxf50-rad)) (0.0)))
(ks-winkel-normalisieren (+ g (/ (* 180.0 r) pi))))
(defun kf-xdata-schreiben (ent drehung-grad / eintrag)
(regapp *kf-xdata-app*)
(setq eintrag (list *kf-xdata-app*
(cons 1000 "kf-edit")
(cons 1040 (float drehung-grad))))
(entmod (append (entget ent) (list (list -3 eintrag))))
ent)
;; Gebauter Drehwinkel (Grad) aus der XDATA, nil wenn keine vorhanden ist.
(defun kf-xdata-lesen (ent / xd daten paar)
(setq xd (entget ent (list *kf-xdata-app*)))
(setq daten (cdr (assoc -3 xd)))
(if daten
(progn
(setq paar (assoc 1040 (cdr (car daten))))
(if paar (cdr paar) nil))
nil))
;; ============================================================
;; BLOCK ABSCHLIESSEN
;; ============================================================
;; Sammelt alle seit last-ent erzeugten Objekte, legt die ATTDEFs an, fasst
;; alles zu KF_<n> zusammen und beschriftet den fertigen Block.
;; Vorbild: gf-block-erstellen (Gefaellestrecke.lsp).
(defun kf-block-erstellen (variante geo hoehe laenge verbindung
startpunkt last-ent kf-nummer
farbe antriebsmotor movimot steuerung drehung /
kf-bname kf-ss ent kf-insert winkel-str)
(setq kf-bname (strcat "KF_" (itoa kf-nummer)))
;; Winkel als nackte Ganzzahl ("26"/"30") - bewusst ueber itoa/fix statt
;; rtos: rtos haengt an DIMZIN/LUPREC/LUNITS der Zeichnung und liefert je
;; nach Zeichnungsprofil unterschiedliche Schreibweisen. Dieser Wert landet
;; als Attribut WINKEL am Block und wird vom Sivas-Export als Schluessel der
;; Tabelle [kf_typ_anzeige] verwendet - er muss profilunabhaengig sein
;; (gleiche Ueberlegung wie bei ssg-sepliste-fmt-koord).
(setq winkel-str (itoa (fix (+ 0.5 (kf-zahl (ssg-json-get variante "winkel"))))))
;; 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))))
;; Alle Entities seit last-ent einsammeln
(setq kf-ss (ssadd))
(setq ent (if last-ent (entnext last-ent) (entnext)))
(while ent
(ssadd ent kf-ss)
(setq ent (entnext 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))
;; Gebauten Drehwinkel festhalten, damit KF_EDIT ihn wiederfindet
(kf-xdata-schreiben kf-insert drehung)
(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)))))
(cons "L_KF_mm" (itoa (fix (+ 0.5 (float laenge)))))
(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)
kf-insert)
;; Naechste freie KF-Nummer in der Zeichnung.
(defun kf-naechste-nummer ( / n ss i nm num)
(setq n 0)
(setq ss (ssget "X" '((0 . "INSERT") (2 . "KF_*"))))
(if ss
(progn
(setq i 0)
(while (< i (sslength ss))
(setq nm (cdr (assoc 2 (entget (ssname ss i)))))
(setq num (atoi (substr nm 4)))
(if (> num n) (setq n num))
(setq i (1+ i)))))
(1+ n))
;; ============================================================
;; 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 Baugruppe steht aufgerichtet im Modell
;; (siehe kf-matrix-aufrecht), ihre Hoehe ist also die Hoehe der Zeichnung.
;; 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)
(setq e (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")))
;; ============================================================
;; C:KETTENFOERDERER - Hauptbefehl
;; ============================================================
(defun c:KETTENFOERDERER ( / daten eingabe variante hoehe verbindung
farbe antriebsmotor movimot steuerung
geo erg laenge skala endpunkt
lmin lmax startpunkt drehung last-ent kf-nummer ent
t0)
;; Laufzeit des Dialogaufbaus protokollieren (Schalter "kf-zeit", siehe
;; ssg_dbg.lsp). Hintergrund: der Dialog erschien beim ersten Menueklick
;; spuerbar verzoegert. Statt zu raten, wird die Zeit bis zum Dialog
;; gemessen - so laesst sich unterscheiden, ob das Lazy-Laden des Moduls,
;; das Lesen der JSON oder der Dialogaufbau selbst die Zeit kostet.
(setq t0 (getvar "MILLISECS"))
(setq daten (kf-daten))
(kf-zeit "Daten geladen" t0)
(if (null daten)
(princ (ssg-text "kf-fehler-daten-leer"))
(progn
(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")))
(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 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 geo (kf-geometrie-messen variante))
(setq erg (kf-laenge-fuer-hoehe geo hoehe lmin lmax))
(if (caddr erg)
(progn
(if (ssg-gui-p) (alert (ssg-text (caddr erg))))
(princ (ssg-text (caddr erg))))
(progn
(setq laenge (car erg) skala (cadr erg))
(setq startpunkt (getpoint (ssg-text "kf-prompt-startpunkt")))
(if (null startpunkt)
(princ (ssg-text "kf-abgebrochen"))
(progn
(setq drehung (getangle startpunkt (ssg-text "kf-prompt-drehung")))
(setq drehung (if drehung (/ (* 180.0 drehung) pi) 0.0))
(ssg-start "Kettenfoerderer" '(("OSMODE") ("ATTREQ") ("ATTDIA")))
(setvar "OSMODE" 0)
(setvar "ATTREQ" 0)
(setvar "ATTDIA" 0)
(setq last-ent (ssg-lastent-ohne-attribute))
(setq kf-nummer (kf-naechste-nummer))
;; Kette und Draufsicht liegen DECKUNGSGLEICH - beide
;; beginnen am gewaehlten Punkt. Die Draufsicht gehoert mit
;; in dieselbe Baugruppe, darum VOR kf-block-erstellen.
(setq endpunkt (kf-kette-bauen variante geo skala startpunkt drehung))
(kf-ansicht-2d-bauen daten startpunkt endpunkt drehung)
(setq ent (kf-block-erstellen variante geo hoehe laenge verbindung
startpunkt last-ent kf-nummer farbe antriebsmotor movimot
steuerung drehung))
(ssg-end)
(princ (ssg-textf "kf-fertig"
(list (strcat "KF_" (itoa kf-nummer))
(rtos (float hoehe) 2 0)
(rtos laenge 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), nicht aus XDATA: der Kettenfoerderer hat keine Aufbau-Historie, die
;; ueber diese beiden Werte hinausgeht - alles Uebrige steht in den
;; Attributen. Ein von Hand verschobener oder gedrehter Block wird dadurch
;; korrekt an seiner NEUEN Lage neu gebaut.
;;
;; 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 ( / ent ed bname attribs daten eingabe variante hoehe
verbindung farbe antriebsmotor movimot steuerung
geo erg laenge skala lmin lmax startpunkt drehung
last-ent kf-nummer endpunkt)
(setq ent (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)))
(if (or (/= (cdr (assoc 0 ed)) "INSERT") (not (wcmatch bname "KF_*")))
(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)))
;; Der gebaute Winkel steckt in der XDATA, eine nachtraegliche
;; Drehung der Referenz in Gruppencode 50 - beides zaehlt.
(setq drehung (kf-drehung-gesamt (kf-xdata-lesen ent)
(cdr (assoc 50 ed))))
(kf-dlg-aus-attributen daten attribs)
(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 eingabe (if (ssg-gui-p) (kf-dialog daten) (kf-konsole daten)))
(if (null eingabe)
(princ (ssg-text "kf-abgebrochen"))
(progn
(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 geo (kf-geometrie-messen variante))
(setq erg (kf-laenge-fuer-hoehe geo hoehe lmin lmax))
(if (caddr erg)
(progn
(if (ssg-gui-p) (alert (ssg-text (caddr erg))))
(princ (ssg-text (caddr erg))))
(progn
(setq laenge (car erg) skala (cadr erg))
(ssg-start "Kettenfoerderer Edit"
'(("OSMODE") ("ATTREQ") ("ATTDIA")))
(setvar "OSMODE" 0)
(setvar "ATTREQ" 0)
(setvar "ATTDIA" 0)
;; Erst jetzt loeschen - ein Abbruch oben laesst die
;; Zeichnung unveraendert.
(entdel ent)
(setq last-ent (ssg-lastent-ohne-attribute))
(setq kf-nummer (kf-naechste-nummer))
(setq endpunkt (kf-kette-bauen variante geo skala
startpunkt drehung))
(kf-ansicht-2d-bauen daten startpunkt endpunkt drehung)
(kf-block-erstellen variante geo hoehe laenge verbindung
startpunkt last-ent kf-nummer farbe antriebsmotor
movimot steuerung drehung)
(ssg-end)
(princ (ssg-textf "kf-edit-fertig"
(list bname (strcat "KF_" (itoa kf-nummer)))))))))))))))
(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