Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

Merge origin/master: i18n-System (de/en) + 30-Grad-AS/ES-Elemente zusammenfuehren

Browse Source 
Lokaler Stand (Modus-3 Randwert-Solver, 30/90-AS/ES, Kreisel-Attribute)
mit dem Remote-Stand (Internationalisierung ssg-text, neue Bloecke,
Sivas-Export) vereint.

Konfliktaufloesung:
- vf_linienzug.lsp: Nicht-interaktive -block-Kerne (fuer Pfad-Modi) behalten,
  interaktive Abfragen (GF-Bogen, Vario-Kurve, ES-Seite) auf ssg-text
  umgestellt. Kein doppelter defun mehr.
- Gefaellestrecke.lsp: 30/90-Winkelabfrage mit den i18n-Seiten-Prompts
  kombiniert; gefaellestrecke-einfuegen-Aufruf mit as-/es-winkel.
- vf_core.lsp: vf-frage-element-winkel nimmt jetzt einen i18n-Header-Key
  (vf-winkel-aus-header / vf-winkel-ein-header) statt festem Text.
- lang/de_DE.json + en_GB.json: neue Keys vf-winkel-aus/ein-header,
  vf-winkel-90/30; gf-seite-Header ohne irrefuehrendes "_90_".
- export_sivas.py: ANZAHL_SEPARATOR/ANZAHL_SCANNER mit N_*-Fallback plus
  Remote-Umsortierung; doppelte "Kreiselart"-Zeile entfernt.
- AS_Element_30_links/rechts.dwg + Separator_SP.dwg (3D): Remote-Version
  (Attribut-Stand) uebernommen. Die KS_AUS-Geometrie-Korrektur der 30-Grad-
  AS-Elemente wird danach in BricsCAD nachgezogen.

Offen (Folge-Commit): die Modus-Treiber in vf_linienzug.lsp
(vf-linienzug-modus / -modus2 / -modus3) sind noch nicht i18n
(ca. 110 Strings).

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
Yuelin Wang
2026-07-20 14:08:13 +02:00
parent bc09b23c23 a56ddb5e6c
commit 6e8f4c75fe
311 changed files with 67986 additions and 49100 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/EtageVarioFoerderer.lsp
+1 -1
View File
@@ -18,5 +18,5 @@
)
(if *vf-core-datei*
(load *vf-core-datei*)
(princ "\n[EtageVarioFoerderer] WARNUNG: vf_core.lsp nicht gefunden - Befehle nicht verfuegbar.")
(princ (ssg-text "vfstart-etage-core-nicht-gefunden"))
)
Lisp/Gefaellestrecke.lsp
+165 -182
View File
@@ -121,15 +121,15 @@
(setq block-datei (strcat block-pfad blockname ".dwg"))
(if (findfile block-datei)
(progn
(princ (strcat "\n Lade Block: " blockname " ..."))
(princ (ssg-textf "gf-lade-block" (list blockname)))
(setq temp-obj
(vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
block-datei 1.0 1.0 1.0 0))
(vla-Delete temp-obj)
(princ " OK")
(princ (ssg-text "gf-status-ok"))
)
(princ (strcat "\n FEHLER: Block-Datei nicht gefunden: " block-datei))
(princ (ssg-textf "gf-fehler-blockdatei-fehlt" (list block-datei)))
)
)
)
@@ -252,7 +252,7 @@
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n FEHLER: Block '" blockname "' fehlt"))
(princ (ssg-textf "gf-fehler-block-fehlt" (list blockname)))
(exit)
)
)
@@ -294,11 +294,11 @@
(+ (car einfuegepunkt) (- (* chv dx-loc) (* shv dy-loc)))
(+ (cadr einfuegepunkt) (+ (* shv dx-loc) (* chv dy-loc)))
(+ (caddr einfuegepunkt) dz-loc)))
(princ (strcat "\n KS_AUS Z=" (rtos (caddr ausgang) 2 2)))
(princ (ssg-textf "gf-status-ks-aus-z" (list (rtos (caddr ausgang) 2 2))))
ausgang
)
(progn
(princ "\n WARNUNG: KS_EIN/KS_AUS fehlt!")
(princ (ssg-text "gf-warnung-ks-fehlt"))
einfuegepunkt
)
)
@@ -310,7 +310,7 @@
(defun insert-inclined-scaled-block (blockname startpunkt laenge winkel hz /
rad-v rad-h chv shv cvv svv scale block-obj endpunkt)
(if (<= laenge 0.1)
(progn (princ "\n (Laenge 0 - uebersprungen)") startpunkt)
(progn (princ (ssg-text "gf-laenge-null-uebersprungen")) startpunkt)
(progn
(ensure-block-loaded blockname)
(setq scale (/ (float laenge) 1000.0))
@@ -333,8 +333,8 @@
(list (+ (car startpunkt) (* laenge chv cvv))
(+ (cadr startpunkt) (* laenge shv cvv))
(+ (caddr startpunkt) (* laenge (- svv)))))
(princ (strcat "\n " blockname " L=" (rtos laenge 2 1)
" -> Z=" (rtos (caddr endpunkt) 2 1)))
(princ (ssg-textf "gf-status-block-l-z"
(list blockname (rtos laenge 2 1) (rtos (caddr endpunkt) 2 1))))
endpunkt
)
)
@@ -425,7 +425,7 @@
(if (null (car (atoms-family 1 '("GET-LINE-START-END-POINTS"))))
(defun get-line-start-end-points (msg / ent obj obj-name sp ep)
(princ msg)
(setq ent (entsel "\n >> Linie waehlen: "))
(setq ent (entsel (ssg-text "gf-prompt-linie-waehlen")))
(if ent
(progn
(setq obj (vlax-ename->vla-object (car ent)))
@@ -436,11 +436,11 @@
(vlax-variant-value (vla-get-StartPoint obj))))
(setq ep (vlax-safearray->list
(vlax-variant-value (vla-get-EndPoint obj))))
(princ (strcat "\n 3D-Linie: Z_start=" (rtos (caddr sp) 2 2)
" Z_end=" (rtos (caddr ep) 2 2)))
(princ (ssg-textf "gf-status-3dlinie-z"
(list (rtos (caddr sp) 2 2) (rtos (caddr ep) 2 2))))
(list sp ep)
)
(t (princ "\n Fehler: keine Linie!") nil)
(t (princ (ssg-text "gf-fehler-keine-linie")) nil)
)
)
nil
@@ -525,7 +525,7 @@
(defun gf-insert-hz-incl-scaled (blockname pt laenge hz-grad vert-grad /
chz shz cv sv scale block-obj endpunkt)
(if (<= laenge 0.1)
(progn (princ "\n (Laenge 0 - uebersprungen)") pt)
(progn (princ (ssg-text "gf-laenge-null-uebersprungen")) pt)
(progn
(ensure-block-loaded blockname)
(setq scale (/ (float laenge) 1000.0))
@@ -546,11 +546,9 @@
(list (+ (car pt) (* laenge chz cv))
(+ (cadr pt) (* laenge shz cv))
(+ (caddr pt) (* (- sv) laenge))))
(princ (strcat "\n HzIncl " blockname
" L=" (rtos laenge 2 0)
" hz=" (rtos hz-grad 2 0) grad-zeichen
" v=" (rtos vert-grad 2 1) grad-zeichen
" -> Z=" (rtos (caddr endpunkt) 2 1)))
(princ (ssg-textf "gf-status-hzincl"
(list blockname (rtos laenge 2 0) (rtos hz-grad 2 0) grad-zeichen
(rtos vert-grad 2 1) grad-zeichen (rtos (caddr endpunkt) 2 1))))
endpunkt
)
)
@@ -579,10 +577,9 @@
(list (+ (car pt) (+ (* dx chz cv) (* dz chz sv)))
(+ (cadr pt) (+ (* dx shz cv) (* dz shz sv)))
(+ (caddr pt) (+ (* (- sv) dx) (* cv dz)))))
(princ (strcat "\n HzKS " blockname
" hz=" (rtos hz-grad 2 0) grad-zeichen
" v=" (rtos vert-grad 2 1) grad-zeichen
" -> Z=" (rtos (caddr endpunkt) 2 1)))
(princ (ssg-textf "gf-status-hzks"
(list blockname (rtos hz-grad 2 0) grad-zeichen
(rtos vert-grad 2 1) grad-zeichen (rtos (caddr endpunkt) 2 1))))
endpunkt
)
@@ -597,7 +594,7 @@
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n FEHLER: Block '" blockname "' fehlt!"))
(princ (ssg-textf "gf-fehler-block-fehlt-ausruf" (list blockname)))
(exit)
)
)
@@ -643,13 +640,12 @@
(list (+ (car p-aus-rot) (car offset))
(+ (cadr p-aus-rot) (cadr offset))
(+ (caddr p-aus-rot) (caddr offset))))
(princ (strcat "\n Gefaellebogen " blockname
" hz=" (rtos hz-grad 2 0) grad-zeichen
" -> Z=" (rtos (caddr ausgang) 2 1)))
(princ (ssg-textf "gf-status-gefaellebogen"
(list blockname (rtos hz-grad 2 0) grad-zeichen (rtos (caddr ausgang) 2 1))))
ausgang
)
(progn
(princ (strcat "\n WARNUNG: KS fehlt in '" blockname "'"))
(princ (ssg-textf "gf-warnung-ks-fehlt-in" (list blockname)))
pt
)
)
@@ -689,7 +685,7 @@
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n WARNUNG: " blockname " fehlt - Nullwerte"))
(princ (ssg-textf "gf-warnung-block-fehlt-nullwerte" (list blockname)))
'(0 0)
)
(progn
@@ -707,12 +703,12 @@
(progn
(setq dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
(setq dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
(princ (strcat "\n " blockname
": dx=" (rtos dx 2 1) " dz=" (rtos dz 2 1)))
(princ (ssg-textf "gf-status-bogen-masse"
(list blockname (rtos dx 2 1) (rtos dz 2 1))))
(list dx dz)
)
(progn
(princ (strcat "\n WARNUNG: KS fehlt in " blockname))
(princ (ssg-textf "gf-warnung-ks-fehlt-in2" (list blockname)))
'(0 0)
)
)
@@ -761,7 +757,7 @@
(setq rest (vl-remove best rest))
)
(progn
(princ "\n WARNUNG: Kette unterbrochen!")
(princ (ssg-text "gf-warnung-kette-unterbrochen"))
(setq rest nil)
)
)
@@ -858,25 +854,24 @@
;; dH_grade = L_total * sin(v); dH_fix = aus-dz + ein-dz + sum-dz-bogen
(setq L-gerade (+ L-gerade (float aus-dx) (float ein-dx) (float sum-dx-bogen)))
(setq deltaH-eff (- (float deltaH) (float aus-dz) (float ein-dz) sum-dz-bogen))
(princ (strcat "\n Gesamte Nennlaenge (inkl. Bogen-dx): " (rtos L-gerade 2 1) " mm"))
(princ (strcat "\n Feste Hoehenanteile (AS/ES-dz + Bogen-dz): "
(rtos (+ (float aus-dz) (float ein-dz) sum-dz-bogen) 2 1) " mm"))
(princ (strcat "\n aus-dz=" (rtos (float aus-dz) 2 2)
" ein-dz=" (rtos (float ein-dz) 2 2)
" Bogen-dz=" (rtos sum-dz-bogen 2 2)))
(princ (strcat "\n Effektive Resthoehe fuer Grade: " (rtos deltaH-eff 2 1) " mm"))
(princ (ssg-textf "gf-status-nennlaenge" (list (rtos L-gerade 2 1))))
(princ (ssg-textf "gf-status-feste-hoehenanteile"
(list (rtos (+ (float aus-dz) (float ein-dz) sum-dz-bogen) 2 1))))
(princ (ssg-textf "gf-status-dz-detail"
(list (rtos (float aus-dz) 2 2) (rtos (float ein-dz) 2 2) (rtos sum-dz-bogen 2 2))))
(princ (ssg-textf "gf-status-resthoehe" (list (rtos deltaH-eff 2 1))))
(cond
((<= L-gerade 0.1)
(princ "\n WARNUNG: keine geraden Strecken -> Fallback 3 Grad")
(princ (ssg-text "gf-warnung-keine-geraden"))
3.0)
((< deltaH-eff 0)
(princ "\n WARNUNG: feste Anteile > deltaH -> Fallback 1 Grad")
(princ (ssg-text "gf-warnung-feste-anteile"))
1.0)
(t
(setq sin-alpha (/ deltaH-eff L-gerade))
(if (> sin-alpha 1.0) (setq sin-alpha 1.0))
(setq alpha (* (asin sin-alpha) (/ 180.0 pi)))
(princ (strcat "\n>>> Naeherungswinkel: " (rtos alpha 2 3) grad-zeichen))
(princ (ssg-textf "gf-status-naeherungswinkel" (list (rtos alpha 2 3) grad-zeichen)))
alpha
)
)
@@ -922,10 +917,9 @@
(setq bseite (nth 4 seg))
(cond
((= typ "Linie")
(princ (strcat "\n\n" (itoa (1+ i)) "/" (itoa n)
": Staustrecke L=" (rtos laenge 2 1) " mm"
" hz=" (rtos hz 2 1) grad-zeichen
" v=" (rtos grade 2 2) grad-zeichen))
(princ (ssg-textf "gf-status-linie-staustrecke"
(list (1+ i) n (rtos laenge 2 1) (rtos hz 2 1) grad-zeichen
(rtos grade 2 2) grad-zeichen)))
(setq endpunkt
(gf-insert-hz-incl-scaled
"Staustrecke_SP_1000_mm" (car aktuell-frame) laenge hz grade))
@@ -939,10 +933,8 @@
;; Separator am Ende dieser Linie, falls naechstes Segment ein Bogen ist
(if (and naechstes (= (car naechstes) "Bogen"))
(progn
(princ (strcat "\n\n" (itoa (1+ i)) "S/" (itoa n)
": Separator 300mm (vor Bogen)"
" hz=" (rtos hz 2 1) grad-zeichen
" v=" (rtos grade 2 2) grad-zeichen))
(princ (ssg-textf "gf-status-separator-vor-bogen"
(list (1+ i) n (rtos hz 2 1) grad-zeichen (rtos grade 2 2) grad-zeichen)))
(setq endpunkt
(gf-insert-hz-with-ks
"Staustrecke_Separator_SP_300_mm" (car aktuell-frame) hz grade 300 0))
@@ -952,9 +944,8 @@
)
((= typ "Bogen")
(setq blockname (gf-bogen-blockname bwinkel bseite))
(princ (strcat "\n\n" (itoa (1+ i)) "/" (itoa n)
": " blockname
" hz=" (rtos hz 2 1) grad-zeichen))
(princ (ssg-textf "gf-status-bogen-einfuegen"
(list (1+ i) n blockname (rtos hz 2 1) grad-zeichen)))
;; Gefaellebogen: KS_EIN an aktuellem Rahmen ausrichten (volle 3D-Rotation)
(setq aktuell-frame (insert-block-ks-to-ks blockname aktuell-frame))
)
@@ -962,7 +953,7 @@
(setq i (1+ i))
)
(princ "\n\n=========================================")
(princ "\n>>> Linienzug-Gefaellestrecke eingefuegt! <<<")
(princ (ssg-text "gf-status-linienzug-eingefuegt"))
(princ "\n=========================================")
aktuell-frame)
@@ -1014,17 +1005,17 @@
rad-v-korr ein-hz-as-k rad-h-as-k xu-as-meas
rad-h-es-k xu-es-meas dz-as-ist dz-es-ist
dH-korr grade-prev iter)
(princ "\n\n>>> MODUS 3: Linienzug auswaehlen <<<")
(princ "\nBitte alle Linien (LINE) und Boegen (ARC) des Pfades auswaehlen,")
(princ "\ndann ENTER druecken:")
(princ (ssg-text "gf-modus3-header"))
(princ (ssg-text "gf-modus3-hinweis1"))
(princ (ssg-text "gf-modus3-hinweis2"))
;; Selektion
(setq ss (ssget (list (cons 0 "LINE,ARC"))))
(if (null ss)
(progn (princ "\nKeine Objekte ausgewaehlt!") (exit))
(progn (princ (ssg-text "gf-fehler-keine-objekte")) (exit))
)
(setq n (sslength ss))
(princ (strcat "\n " (itoa n) " Objekte ausgewaehlt."))
(princ (ssg-textf "gf-status-objekte-ausgewaehlt" (list n)))
;; Objekte in Liste
(setq obj-liste '() i 0)
@@ -1037,30 +1028,30 @@
;; Startpunkt: Kettenanfang (Sortierung) + KS_EIN-Position des AUS-Elements
;; Z-Hoehe = Anschlusshoehe der Gesamtstrecke (deltaH-Referenz oben)
(setq startpunkt
(getpoint "\nStartpunkt (3D) waehlen - KS_EIN AUS-Element / Kettenanfang: "))
(getpoint (ssg-text "gf-prompt-startpunkt-kette")))
(if (null startpunkt)
(progn (princ "\nKein Startpunkt!") (exit))
(progn (princ (ssg-text "gf-fehler-kein-startpunkt")) (exit))
)
;; Endpunkt: KS_AUS-Position des EIN-Elements (Z-Referenz unten)
;; deltaH = |startpunkt.Z - endpunkt-ref.Z|
(setq endpunkt-ref
(getpoint "\nEndpunkt (3D) waehlen - KS_AUS EIN-Element / Kettenende: "))
(getpoint (ssg-text "gf-prompt-endpunkt-kette")))
(if (null endpunkt-ref)
(progn (princ "\nKein Endpunkt!") (exit))
(progn (princ (ssg-text "gf-fehler-kein-endpunkt")) (exit))
)
;; DeltaH aus Z-Koordinaten
(setq deltaH (abs (- (caddr startpunkt) (caddr endpunkt-ref))))
(princ (strcat "\n " delta-sym "H aus 3D-Punkten: " (rtos deltaH 2 1) " mm"))
(princ (ssg-textf "gf-status-deltah-3dpunkte" (list delta-sym (rtos deltaH 2 1))))
;; Kette sortieren
(princ "\n Sortiere Segmente ...")
(princ (ssg-text "gf-status-sortiere-segmente"))
(setq kette (gf-sortiere-objekte obj-liste startpunkt))
(if (null kette)
(progn (alert "Keine verbundene Kette gefunden!") (exit))
(progn (alert (ssg-text "gf-alert-keine-kette")) (exit))
)
(princ (strcat " " (itoa (length kette)) " Segmente gefunden."))
(princ (ssg-textf "gf-status-segmente-gefunden" (list (length kette))))
;; Segmente analysieren
(setq segmente (gf-analysiere-kette kette))
@@ -1071,20 +1062,20 @@
;; AUS-Element: 30/90 (vor Seite), dann Seite (vor Winkelberechnung, da die
;; Laengenanpassung von der AS/ES-Masse abhaengt). Masse fuer Variante setzen.
(setq gf-as-winkel (vf-frage-element-winkel "AUS-Element"))
(princ "\n\nAUS-Element (AS_Element_*) - Seite waehlen:")
(princ "\n 1 - Links")
(princ "\n 2 - Rechts")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(setq gf-as-winkel (vf-frage-element-winkel "vf-winkel-aus-header"))
(princ (ssg-text "gf-seite-aus-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(setq as-seite (if (= antwort "2") "rechts" "links"))
(vf-set-as-masse gf-as-winkel as-seite)
;; EIN-Element: 30/90 + Seite
(setq gf-es-winkel (vf-frage-element-winkel "EIN-Element"))
(princ "\n\nEIN-Element (ES_Element_*) - Seite waehlen:")
(princ "\n 1 - Links")
(princ "\n 2 - Rechts")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(setq gf-es-winkel (vf-frage-element-winkel "vf-winkel-ein-header"))
(princ (ssg-text "gf-seite-ein-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(setq es-seite (if (= antwort "2") "rechts" "links"))
(vf-set-es-masse gf-es-winkel es-seite)
@@ -1135,36 +1126,35 @@
)
;; Segmente nach Laengenanpassung anzeigen
(princ "\n\n--- Segment-Analyse (Laengen nach Kuerzung) ---")
(princ (ssg-text "gf-status-segment-analyse-header"))
(setq idx 0)
(foreach seg segmente
(setq idx (1+ idx))
(if (= (car seg) "Linie")
(princ (strcat "\n " (itoa idx) ". Linie L=" (rtos (caddr seg) 2 1)
" mm hz=" (rtos (cadr seg) 2 1) grad-zeichen))
(princ (strcat "\n " (itoa idx) ". Bogen " (itoa (nth 3 seg))
grad-zeichen " " (nth 4 seg)
" hz-Eingang=" (rtos (cadr seg) 2 1) grad-zeichen))
(princ (ssg-textf "gf-status-segment-linie"
(list idx (rtos (caddr seg) 2 1) (rtos (cadr seg) 2 1) grad-zeichen)))
(princ (ssg-textf "gf-status-segment-bogen"
(list idx (itoa (nth 3 seg)) grad-zeichen (nth 4 seg)
(rtos (cadr seg) 2 1) grad-zeichen)))
)
)
(princ (strcat "\n Seg " (itoa (1+ first-idx)) " (1. Linie): -" (rtos aus-dx 2 1) " mm (AUS-Element)"))
(princ "\n Jede Linie vor Bogen: -300 mm (Bogen-Separator)")
(princ (strcat "\n Seg " (itoa (1+ last-idx)) " (letzte Linie): -300 mm (EIN-Sep) -" (rtos ein-dx 2 1) " mm (EIN-Element)"))
(princ (strcat "\n Eintrittsrichtung: " (rtos entry-hz 2 1) grad-zeichen))
(princ (strcat "\n Austrittsrichtung: " (rtos exit-hz 2 1) grad-zeichen))
(princ (ssg-textf "gf-status-seg-erste-linie" (list (1+ first-idx) (rtos aus-dx 2 1))))
(princ (ssg-text "gf-status-linie-vor-bogen"))
(princ (ssg-textf "gf-status-seg-letzte-linie" (list (1+ last-idx) (rtos ein-dx 2 1))))
(princ (ssg-textf "gf-status-eintrittsrichtung" (list (rtos entry-hz 2 1) grad-zeichen)))
(princ (ssg-textf "gf-status-austrittsrichtung" (list (rtos exit-hz 2 1) grad-zeichen)))
;; Gefaellewinkel berechnen (1 Extra-Separator vor EIN-Element)
(princ "\n\n Berechne Gefaellewinkel aus Geometrie ...")
(princ (ssg-text "gf-status-berechne-winkel"))
(setq grade (gf-winkel-berechnen segmente deltaH 1))
;; Manuelle Anpassung
(setq antwort
(getstring (strcat "\nBerechneten Winkel "
(rtos grade 2 3) grad-zeichen
" verwenden? (j/n) [j]: ")))
(getstring (ssg-textf "gf-prompt-winkel-verwenden"
(list (rtos grade 2 3) grad-zeichen))))
(if (= (strcase antwort) "N")
(progn
(setq grade (getreal "\nGefaellewinkel (Grad): "))
(setq grade (getreal (ssg-text "gf-prompt-gefaellewinkel")))
(if (or (null grade) (<= grade 0)) (setq grade 3.0))
)
)
@@ -1176,7 +1166,7 @@
;; Garantiert: dz_AS(v) + L_stau*sin(v) + dz_ES(v) + dz_bogen = deltaH
(if (and *gf-L-ohne-as-es* (> *gf-L-ohne-as-es* 0.1))
(progn
(princ "\n Messe tatsaechliche AS/ES-Absenkung (iterativ) ...")
(princ (ssg-text "gf-status-messe-absenkung"))
(setq grade-prev -999.0 iter 0)
(while (and (< iter 4) (> (abs (- grade grade-prev)) 0.001))
(setq grade-prev grade)
@@ -1200,16 +1190,16 @@
(if (and (> dH-korr 0.0) (< (/ dH-korr *gf-L-ohne-as-es*) 1.0))
(setq grade (* (asin (/ dH-korr *gf-L-ohne-as-es*)) (/ 180.0 pi)))
(progn
(princ "\n WARNUNG: Korrektur ausserhalb Bereich, Winkel unveraendert")
(princ (ssg-text "gf-warnung-korrektur-bereich"))
(setq grade-prev grade)
)
)
(setq iter (1+ iter))
)
(princ (strcat "\n AS: " (rtos dz-as-ist 2 2) " mm"
" ES: " (rtos dz-es-ist 2 2) " mm"))
(princ (strcat "\n>>> Korrigierter Gefaellewinkel: " (rtos grade 2 3) grad-zeichen
" (nach " (itoa iter) " Iter.)"))
(princ (ssg-textf "gf-status-as-es-mm"
(list (rtos dz-as-ist 2 2) (rtos dz-es-ist 2 2))))
(princ (ssg-textf "gf-status-korrigierter-winkel"
(list (rtos grade 2 3) grad-zeichen (itoa iter))))
)
)
@@ -1220,18 +1210,18 @@
;; Zusammenfassung
(princ "\n\n=========================================")
(princ (strcat "\n>>> Segmente: " (itoa (length segmente))))
(princ (strcat "\n>>> " delta-sym "H: " (rtos deltaH 2 2) " mm"))
(princ (strcat "\n>>> " delta-sym "L: " (rtos delta-l-gf 2 1) " mm"))
(princ (strcat "\n>>> Gefaellewinkel: " (rtos grade 2 3) grad-zeichen))
(princ (strcat "\n>>> Eintrittswinkel: " (rtos entry-hz 2 1) grad-zeichen))
(princ (strcat "\n>>> Austrittswinkel: " (rtos exit-hz 2 1) grad-zeichen))
(princ (strcat "\n>>> AUS-Element: " as-block))
(princ (strcat "\n>>> EIN-Element: " es-block))
(princ (ssg-textf "gf-status-zus-segmente" (list (length segmente))))
(princ (ssg-textf "gf-status-zus-deltah" (list delta-sym (rtos deltaH 2 2))))
(princ (ssg-textf "gf-status-zus-deltal" (list delta-sym (rtos delta-l-gf 2 1))))
(princ (ssg-textf "gf-status-zus-winkel" (list (rtos grade 2 3) grad-zeichen)))
(princ (ssg-textf "gf-status-zus-eintrittswinkel" (list (rtos entry-hz 2 1) grad-zeichen)))
(princ (ssg-textf "gf-status-zus-austrittswinkel" (list (rtos exit-hz 2 1) grad-zeichen)))
(princ (ssg-textf "gf-status-zus-aus-element" (list as-block)))
(princ (ssg-textf "gf-status-zus-ein-element" (list es-block)))
(princ "\n=========================================")
;; Bestaetigung
(setq antwort (getstring "\nEinfuegen? (1=Ja / 2=Nein) [1]: "))
(setq antwort (getstring (ssg-text "gf-prompt-einfuegen")))
(if (not (= antwort "2"))
(progn
;; GF-Nummer und Entity-Grenze vor erster Einfuegung sichern.
@@ -1252,10 +1242,9 @@
(setq xu-entry (list (* (cos rad-h-as)(cos rad-v-as))
(* (sin rad-h-as)(cos rad-v-as))
(- (sin rad-v-as))))
(princ (strcat "\n\n>>> AUS-Element: " as-block
" Fahrtrichtung=" (rtos entry-hz 2 1) grad-zeichen
" KS_EIN-hz=" (rtos ein-hz-as 2 1) grad-zeichen
" Z=" (rtos (caddr startpunkt) 2 1)))
(princ (ssg-textf "gf-status-aus-element-detail"
(list as-block (rtos entry-hz 2 1) grad-zeichen
(rtos ein-hz-as 2 1) grad-zeichen (rtos (caddr startpunkt) 2 1))))
;; Block-Ursprung (nicht KS_EIN!) in X/Y auf startpunkt setzen, damit die
;; Mittelachse der Foerderstrecke (KS_AUS-Richtung) exakt durch den
;; ausgewaehlten Startpunkt verlaeuft. KS_EIN sitzt seitlich versetzt
@@ -1271,7 +1260,7 @@
(setq aktuell-frame (gf-linienzug-einfuegen segmente grade aktuell-frame))
;; Separator vor EIN-Element
(princ "\n>>> Separator vor EIN-Element")
(princ (ssg-text "gf-status-separator-vor-ein"))
(setq sep-endpunkt
(gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm"
(car aktuell-frame) exit-hz grade 300 0))
@@ -1287,12 +1276,12 @@
;; seine eigene Achse verlaeuft damit trivial durch diesen Punkt.
;; Die Z-Hoehe wird jedoch an KS_AUS gemessen, damit KS_AUS.Z exakt
;; auf endpunkt-ref.Z landet (garantiert die gewuenschte DeltaH).
(princ (strcat "\n>>> EIN-Element: " es-block
" Ziel-Z=" (rtos (caddr endpunkt-ref) 2 1)))
(princ (ssg-textf "gf-status-ein-element-detail"
(list es-block (rtos (caddr endpunkt-ref) 2 1))))
(setq es-aus-frame
(insert-block-mixed-to-ks es-block sep-frame
(caddr endpunkt-ref) "KS_EIN" "KS_AUS"))
(princ (strcat "\n Z-Hoehe KS_AUS: " (rtos (caddr (car es-aus-frame)) 2 1) " mm"))
(princ (ssg-textf "gf-status-z-hoehe-ks-aus" (list (rtos (caddr (car es-aus-frame)) 2 1))))
;; --- GF_N-Block erstellen ---
@@ -1351,10 +1340,10 @@
es-seite)
(princ "\n\n=========================================")
(princ "\n>>> Fertig! <<<")
(princ (ssg-text "gf-status-fertig"))
(princ "\n=========================================")
)
(princ "\nAbgebrochen.")
(princ (ssg-text "gf-status-abgebrochen"))
)
)
@@ -1526,7 +1515,7 @@
;; Aufsteigende, eindeutige ID vergeben (wie beim Kreisel), falls verfuegbar.
(if (car (atoms-family 1 '("SSG-ID-GENERATE")))
(ssg-id-generate gf-insert))
(princ (strcat "\n>>> GF-Block erstellt: " gf-bname " (" typ-str ")"))
(princ (ssg-textf "gf-status-gf-block-erstellt" (list gf-bname typ-str)))
gf-insert
)
@@ -1574,35 +1563,32 @@
;; Mittelachse der Foerderstrecke (KS_AUS-Richtung) exakt durch den
;; ausgewaehlten Startpunkt verlaeuft (analog Modus 3). Die Z-Hoehe wird
;; weiterhin an KS_EIN gemessen, damit KS_EIN.Z = startpunkt.Z gilt.
(princ (strcat "\n\n1/4: " as-block
" Fahrtrichtung=" (rtos hz 2 1) grad-zeichen
" KS_EIN-hz=" (rtos ein-hz 2 1) grad-zeichen
" v=" (rtos winkel 2 1) grad-zeichen))
(princ (ssg-textf "gf-status-schritt1-aus"
(list as-block (rtos hz 2 1) grad-zeichen (rtos ein-hz 2 1) grad-zeichen
(rtos winkel 2 1) grad-zeichen)))
(setq startframe (make-frame-from-dir startpunkt xu-ein))
(setq aktuell-frame
(insert-block-mixed-to-ks as-block startframe (caddr startpunkt) nil "KS_EIN"))
(setq nach-aus-pt (car aktuell-frame))
;; 2/4: Staustrecke (skalierbar, hz+vert)
(princ (strcat "\n\n2/4: Staustrecke L=" (rtos L_stau 2 1)
" mm hz=" (rtos hz 2 1) grad-zeichen
" v=" (rtos winkel 2 1) grad-zeichen))
(princ (ssg-textf "gf-status-schritt2-staustrecke"
(list (rtos L_stau 2 1) (rtos hz 2 1) grad-zeichen (rtos winkel 2 1) grad-zeichen)))
(setq stau-endpunkt
(gf-insert-hz-incl-scaled
"Staustrecke_SP_1000_mm" (car aktuell-frame) L_stau hz winkel))
(setq aktuell-frame (make-frame-from-dir stau-endpunkt xu-incl))
;; 3/4: Separator 300mm
(princ (strcat "\n\n3/4: Separator 300mm"
" hz=" (rtos hz 2 1) grad-zeichen
" v=" (rtos winkel 2 1) grad-zeichen))
(princ (ssg-textf "gf-status-schritt3-separator"
(list (rtos hz 2 1) grad-zeichen (rtos winkel 2 1) grad-zeichen)))
(setq sep-endpunkt
(gf-insert-hz-with-ks
"Staustrecke_Separator_SP_300_mm" (car aktuell-frame) hz winkel 300 0))
(setq sep-frame (make-frame-from-dir sep-endpunkt xu-incl))
;; 4/4: EIN-Element (KS-zu-KS)
(princ (strcat "\n\n4/4: " es-block))
(princ (ssg-textf "gf-status-schritt4-ein" (list es-block)))
(setq endpunkt (car (insert-block-ks-to-ks es-block sep-frame)))
;; Abgeleitete Werte: echte Endhoehe aus tatsaechlicher Ketten-Platzierung
@@ -1626,7 +1612,7 @@
es-seite))
(princ "\n\n=========================================")
(princ "\n>>> Gefaellestrecke erfolgreich eingefuegt! <<<")
(princ (ssg-text "gf-status-erfolgreich-eingefuegt"))
(princ "\n=========================================")
;; Rueckgabe: (ename echtes-deltaH echtes-deltaL) - volle Fliesskomma-
;; Genauigkeit, unabhaengig von der auf ganze mm gerundeten HOEHE_VON/
@@ -1644,24 +1630,24 @@
deltaX deltaY startpunkt-fuer-einfuegen hz-winkel)
(princ "\n=========================================")
(princ "\n GEFAELLESTRECKE GENERATOR v2.0")
(princ "\n Richtung: immer AB (nach unten)")
(princ (ssg-text "gf-banner-titel"))
(princ (ssg-text "gf-banner-richtung"))
(princ "\n=========================================")
;; Bibliothek initialisieren
(if (not (gf-init-bibliothek))
(progn
(alert "Fehler beim Initialisieren der Bibliothek!\nBitte DXFM_DATA pruefen.")
(alert (ssg-text "gf-alert-init-fehler"))
(exit)
)
)
;; Eingabemodus
(princ "\n\nEingabemodus waehlen:")
(princ "\n 1 - Werte manuell eingeben (einfache Strecke)")
(princ "\n 2 - 3D-Linie auswaehlen (einfache Strecke)")
(princ "\n 3 - Linienzug (LINE + ARC) auswaehlen mit Gefaellebogen")
(setq antwort (getstring "\nIhre Wahl (1/2/3) [1]: "))
(princ (ssg-text "gf-eingabemodus-header"))
(princ (ssg-text "gf-eingabemodus-1"))
(princ (ssg-text "gf-eingabemodus-2"))
(princ (ssg-text "gf-eingabemodus-3"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2-3")))
(cond
;; Modus 3: Linienzug mit Bogen
@@ -1679,25 +1665,25 @@
;; Modus 1: Manuelle Eingabe
(if (= eingabe-modus "Manuell")
(progn
(princ "\n\n>>> MODUS 1: Manuelle Werteingabe <<<")
(princ (ssg-text "gf-modus1-header"))
(setq startpunkt-fuer-einfuegen
(getpoint "\nStartpunkt fuer AUS_Element waehlen: "))
(getpoint (ssg-text "gf-prompt-startpunkt-aus")))
(if (null startpunkt-fuer-einfuegen)
(setq startpunkt-fuer-einfuegen '(0 0 0)))
(setq deltaL (getreal (strcat "\n" delta-sym "L - Abstand (mm): ")))
(setq deltaL (getreal (ssg-textf "gf-prompt-deltal-abstand" (list delta-sym))))
(if (or (null deltaL) (<= deltaL 0))
(setq deltaL (ssg-cfg-or "gefaelle" "default_delta_l" 5000.0)))
)
;; Modus 2: 3D-Linie
(progn
(princ "\n\n>>> MODUS 2: 3D-Linie auswaehlen <<<")
(princ (ssg-text "gf-modus2-header"))
(command "BKS" "W")
(princ "\n BKS auf Weltkoordinaten gesetzt.")
(princ (ssg-text "gf-status-bks-welt"))
(setq line-points
(get-line-start-end-points
"\nBitte 3D-Linie fuer Richtung und Laenge auswaehlen:"))
(ssg-text "gf-prompt-3dlinie-richtung")))
(if (null line-points)
(progn (alert "Keine gueltige Linie ausgewaehlt!") (exit))
(progn (alert (ssg-text "gf-alert-keine-linie")) (exit))
)
(setq startpunkt (car line-points)
endpunkt (cadr line-points))
@@ -1708,64 +1694,63 @@
(setq deltaL (sqrt (+ (* deltaX deltaX) (* deltaY deltaY))))
;; hz-Winkel: Fahrtrichtung aus Linienpunkten (in Grad, 0=Ost)
(setq hz-winkel (* (angle '(0.0 0.0) (list deltaX deltaY)) (/ 180.0 pi)))
(princ (strcat "\n Fahrtrichtung: " (rtos hz-winkel 2 1) grad-zeichen
" (aus Linie)"))
(princ (strcat "\n " delta-sym "L = " (rtos deltaL 2 2) " mm"))
(princ (ssg-textf "gf-status-fahrtrichtung-linie" (list (rtos hz-winkel 2 1) grad-zeichen)))
(princ (ssg-textf "gf-status-deltal-mm" (list delta-sym (rtos deltaL 2 2))))
;; Startpunkt separat waehlen (unabhaengig von Linie)
(setq startpunkt-fuer-einfuegen
(getpoint "\nStartpunkt fuer AUS-Element waehlen: "))
(getpoint (ssg-text "gf-prompt-startpunkt-aus")))
(if (null startpunkt-fuer-einfuegen)
(progn (princ "\nKein Startpunkt!") (exit))
(progn (princ (ssg-text "gf-fehler-kein-startpunkt")) (exit))
)
)
)
(princ "\n\n=========================================")
(princ (strcat "\n " delta-sym "L = " (rtos deltaL 2 2) " mm"))
(princ (ssg-textf "gf-status-deltal-mm" (list delta-sym (rtos deltaL 2 2))))
(princ "\n=========================================")
;; Winkelabfrage (beide Modi: manuell)
(setq winkel (getreal "\n\nGefaellewinkel (Grad) [3]: "))
(setq winkel (getreal (ssg-text "gf-prompt-gefaellewinkel-def3")))
(if (or (null winkel) (<= winkel 0))
(setq winkel (ssg-cfg-or "gefaelle" "default_winkel" 3.0)))
(setq winkel (float winkel))
(setq rad (* winkel (/ pi 180.0)))
(princ (strcat "\n>>> Winkel: " (rtos winkel 2 1) grad-zeichen))
(princ (ssg-textf "gf-status-winkel" (list (rtos winkel 2 1) grad-zeichen)))
;; Fahrtrichtung waehlen (nur Modus 1; Modus 2 berechnet hz aus Linie)
(if (= eingabe-modus "Manuell")
(progn
(princ "\n\nFahrtrichtung waehlen:")
(princ "\n 1 - 0° (X-Achse +, Ost)")
(princ "\n 2 - 90° (Y-Achse +, Nord)")
(princ "\n 3 - 180° (X-Achse -, West)")
(princ "\n 4 - 270° (Y-Achse -, Sued)")
(setq antwort (getstring "\nIhre Wahl (1/2/3/4) [1]: "))
(princ (ssg-text "vfc-fahrtrichtung-header"))
(princ (ssg-textf "vfc-fahrtrichtung-0" (list grad-zeichen)))
(princ (ssg-textf "vfc-fahrtrichtung-90" (list grad-zeichen)))
(princ (ssg-textf "vfc-fahrtrichtung-180" (list grad-zeichen)))
(princ (ssg-textf "vfc-fahrtrichtung-270" (list grad-zeichen)))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2-3-4")))
(cond
((= antwort "2") (setq hz-winkel 90.0))
((= antwort "3") (setq hz-winkel 180.0))
((= antwort "4") (setq hz-winkel 270.0))
(t (setq hz-winkel 0.0))
)
(princ (strcat "\n>>> Fahrtrichtung: " (rtos hz-winkel 2 1) grad-zeichen))
(princ (ssg-textf "gf-status-fahrtrichtung" (list (rtos hz-winkel 2 1) grad-zeichen)))
)
)
;; AUS-Element: 30/90 (vor Seite) + Seite, dann Masse fuer Variante setzen
(setq gf-as-winkel (vf-frage-element-winkel "AUS-Element"))
(princ "\n\nAUS-Element (AS_Element_*) - Seite waehlen:")
(princ "\n 1 - Links")
(princ "\n 2 - Rechts")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(setq gf-as-winkel (vf-frage-element-winkel "vf-winkel-aus-header"))
(princ (ssg-text "gf-seite-aus-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(setq as-seite (if (= antwort "2") "rechts" "links"))
(vf-set-as-masse gf-as-winkel as-seite)
;; EIN-Element: 30/90 + Seite
(setq gf-es-winkel (vf-frage-element-winkel "EIN-Element"))
(princ "\n\nEIN-Element (ES_Element_*) - Seite waehlen:")
(princ "\n 1 - Links")
(princ "\n 2 - Rechts")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(setq gf-es-winkel (vf-frage-element-winkel "vf-winkel-ein-header"))
(princ (ssg-text "gf-seite-ein-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(setq es-seite (if (= antwort "2") "rechts" "links"))
(vf-set-es-masse gf-es-winkel es-seite)
@@ -1777,27 +1762,25 @@
;; Validierung
(if (<= L_stau 0.1)
(progn
(alert (strcat "Berechnete Staustreckenlaenge ungueltig: "
(rtos L_stau 2 2) " mm\n"
"Bitte groesseres deltaL oder kleineren Winkel waehlen."))
(alert (ssg-textf "gf-alert-staustrecke-ungueltig" (list (rtos L_stau 2 2))))
(exit)
)
)
;; Zusammenfassung
(princ "\n\n=========================================")
(princ (strcat "\n>>> Fahrtrichtung: " (rtos hz-winkel 2 1) grad-zeichen))
(princ (strcat "\n>>> Winkel: " (rtos winkel 2 1) grad-zeichen))
(princ (strcat "\n>>> AUS-Seite: " as-seite))
(princ (strcat "\n>>> EIN-Seite: " es-seite))
(princ (strcat "\n>>> L_stau: " (rtos L_stau 2 2) " mm"))
(princ (ssg-textf "gf-status-fahrtrichtung" (list (rtos hz-winkel 2 1) grad-zeichen)))
(princ (ssg-textf "gf-status-zus2-winkel" (list (rtos winkel 2 1) grad-zeichen)))
(princ (ssg-textf "gf-status-zus2-aus-seite" (list as-seite)))
(princ (ssg-textf "gf-status-zus2-ein-seite" (list es-seite)))
(princ (ssg-textf "gf-status-zus2-lstau" (list (rtos L_stau 2 2))))
(princ "\n=========================================")
;; Bestaetigung
(setq antwort (getstring "\nEinfuegen? (1=Ja / 2=Nein) [1]: "))
(setq antwort (getstring (ssg-text "gf-prompt-einfuegen")))
(if (not (= antwort "2"))
(gefaellestrecke-einfuegen L_stau (fix winkel) startpunkt-fuer-einfuegen as-seite es-seite hz-winkel deltaL gf-as-winkel gf-es-winkel)
(princ "\nAbgebrochen.")
(princ (ssg-text "gf-status-abgebrochen"))
)
)
)
Lisp/KreiselInsert.lsp
+107 -116
View File
@@ -31,7 +31,7 @@
(strcat (substr *ssg-lisp-pfad* 1 (vl-string-search "/Lisp" *ssg-lisp-pfad*))
"/data/ils/" *ki-dxfm-dim* "/"))
(t
(princ "\n[KreiselInsert] WARNUNG: Block-Pfad nicht ermittelbar!")
(princ (ssg-text "kreisel-warn-blockpfad"))
nil)
)
)
@@ -58,7 +58,7 @@
(defun ssg-cfg-or (sektion schluessel standard) standard)
(defun ssg-cfg (sektion schluessel) nil)
(defun ssg-load-config () nil)
(princ "\n[KreiselInsert] WARNUNG: ssg_core.lsp nicht gefunden - Standardwerte.")
(princ (ssg-text "kreisel-warn-core-fehlt"))
)
)
)
@@ -122,7 +122,7 @@
(progn
;; Neuen Textstil mit Arial erstellen
(command "_.STYLE" style-name "Arial" 0 1 0 "N" "N" "N")
(princ (strcat "\n-> Textstil '" style-name "' mit Arial erstellt"))
(princ (ssg-textf "kreisel-textstil-erstellt" (list style-name)))
)
)
@@ -222,7 +222,7 @@
(cons 11 insertPoint) ;; Ausrichtungspunkt
))
(princ (strcat "\n-> Beschriftung: " textStr " (Höhe=" (rtos textHoehe 2 0) "mm, Arial, zentriert)"))
(princ (ssg-textf "kreisel-beschriftung-erzeugt" (list textStr (rtos textHoehe 2 0))))
textStr
)
@@ -230,9 +230,9 @@
;; Kreiselart abfragen. Rueckgabe: "PIN" oder "STANDARD"
(defun kreisel-ask-typ ( / typNum typ)
(princ "\n[1] STANDARD (ohne PIN)")
(princ "\n[2] PIN")
(princ (strcat "\nBitte waehlen <" (if (= #Kreisel_Typ "PIN") "2" "1") ">: "))
(princ (ssg-text "kreisel-typ-opt-standard"))
(princ (ssg-text "kreisel-typ-opt-pin"))
(princ (ssg-textf "kreisel-typ-prompt" (list (if (= #Kreisel_Typ "PIN") "2" "1"))))
(setq typNum (getstring ""))
(cond
((= typNum "2") (setq typ "PIN"))
@@ -337,7 +337,7 @@
(progn
(setq z-hoehe (caddr basePoint))
(setq block-hoehe (rtos z-hoehe 2 0))
(princ (strcat "\n-> Höhe aus Basispunkt übernommen: " block-hoehe))
(princ (ssg-textf "kreisel-hoehe-aus-basispunkt" (list block-hoehe)))
)
(progn
;; Höhe aus Attributen lesen
@@ -454,12 +454,12 @@
;; --- Block erzeugen (Entities werden aus Zeichnung entfernt) ---
(if (> (sslength ss) 0)
(command "_.-BLOCK" bname (list 0.0 0.0 0.0) ss "")
(princ "\nFehler: Keine Entities zum Block erstellen!")
(princ (ssg-text "kreisel-fehler-keine-entities"))
)
(princ (strcat "\n-> Neue Blockdefinition: " bname))
(princ (ssg-textf "kreisel-neue-blockdef" (list bname)))
)
(princ (strcat "\n-> Verwende bestehende Blockdefinition: " bname))
(princ (ssg-textf "kreisel-bestehende-blockdef" (list bname)))
)
;; --- Block am Zielpunkt einfuegen (ohne Attribut-Dialog) ---
@@ -495,8 +495,7 @@
(if (atoms-family 1 '("ssg-id-generate"))
(ssg-id-generate block-ent)
)
(princ (strcat "\n-> Kreisel #" (itoa kreisel-nummer) " eingefügt: " bname
" (Höhe=" block-hoehe ")"))
(princ (ssg-textf "kreisel-eingefuegt" (list (itoa kreisel-nummer) bname block-hoehe)))
(entlast)
)
@@ -514,19 +513,19 @@
;; --------------------------------------------
(defun c:KreiselInsert ( / pt abstand typ rotation rotStr hoehe
selectedEnt blockAttribs oldOsmode)
(ssg-start "Kreisel Modul einfuegen" '(("OSMODE") ("CECOLOR")))
(ssg-start (ssg-text "kreisel-start-insert") '(("OSMODE") ("CECOLOR")))
;; Temporär Osnap für Blockerkennung setzen
(setq oldOsmode (getvar "OSMODE"))
(setvar "OSMODE" (logior oldOsmode 512)) ;; 512 = INS (Block-Einfügepunkt)
;; 1. Einfuegepunkt
(setq pt (getpoint "\nBasispunkt (AN-Seite): "))
(if (null pt)
(progn
(setq pt (getpoint (ssg-text "kreisel-prompt-basispunkt")))
(if (null pt)
(progn
(setvar "OSMODE" oldOsmode)
(ssg-end)
(princ "\nBefehl abgebrochen.")
(ssg-end)
(princ (ssg-text "kreisel-abbruch-befehl"))
(princ)
(return)
)
@@ -546,41 +545,39 @@
(setq blockAttribs (ssg-attrib-read selectedEnt))
(assoc "HOEHE" blockAttribs))
(setq hoehe (atof (cdr (assoc "HOEHE" blockAttribs))))
(princ (strcat "\n-> Höhe von bestehendem Kreisel übernommen: " (rtos hoehe 2 0)))
(princ (ssg-textf "kreisel-hoehe-von-bestehendem" (list (rtos hoehe 2 0))))
)
;; Fall 2: Punkt hat Z-Koordinate > 0
((and (> (length pt) 2) (> (caddr pt) 0))
(setq hoehe (caddr pt))
(princ (strcat "\n-> Höhe aus 3D-Punkt übernommen: " (rtos hoehe 2 0)))
(princ (ssg-textf "kreisel-hoehe-aus-3dpunkt" (list (rtos hoehe 2 0))))
)
;; Fall 3: Sonst separat abfragen
(t
(setq hoehe (getreal (strcat "\nHöhe (Z-Koordinate) <" (rtos *kreisel-default-hoehe* 2 0) ">: ")))
(setq hoehe (getreal (ssg-textf "kreisel-prompt-hoehe-z" (list (rtos *kreisel-default-hoehe* 2 0)))))
(if (null hoehe) (setq hoehe *kreisel-default-hoehe*))
)
)
;; 3. Abstand
(initget 6)
(setq abstand (getdist (list (car pt) (cadr pt))
(strcat "\nAbstand (Tangentenlaenge) <"
(rtos *kreisel-default-laenge* 2 0) ">: ")))
(setq abstand (getdist (list (car pt) (cadr pt))
(ssg-textf "kreisel-prompt-abstand" (list (rtos *kreisel-default-laenge* 2 0)))))
(if (null abstand) (setq abstand *kreisel-default-laenge*))
(princ (strcat "\n-> Abstand: " (rtos abstand 2 0) " mm"))
(princ (ssg-textf "kreisel-abstand-ausgabe" (list (rtos abstand 2 0))))
;; 4. Rotation
(setq rotStr (getstring "\nRotation in Grad <0>: "))
(setq rotStr (getstring (ssg-text "kreisel-prompt-rotation")))
(if (= rotStr "")
(setq rotation 0.0)
(setq rotation (atof rotStr))
)
;; 5. Kreiselart
(setq typ (kreisel-ask-typ))
(princ (strcat "\n-> Rotation: " (rtos rotation 2 1)
" Höhe: " (rtos hoehe 2 0)
" Kreiselart: " typ))
(princ (ssg-textf "kreisel-insert-zusammenfassung"
(list (rtos rotation 2 1) (rtos hoehe 2 0) typ)))
;; 6. Modul einfuegen
(draw-module (list (car pt) (cadr pt) hoehe) abstand rotation
@@ -590,7 +587,7 @@
;; KEIN weiteres (setvar "OSMODE" ...) mehr nötig!
;; ssg-end stellt nur CLAYER und CMDECHO wieder her, nicht OSMODE
(princ "\nKreisel Modul eingefuegt.")
(princ (ssg-text "kreisel-insert-fertig"))
(ssg-end)
)
@@ -607,20 +604,20 @@
;; -----------------------------------------------
(defun c:KreiselConnect ( / ptStart ptEnd dx dy dist abstand rotation typ hoehe)
(ssg-start "Kreisel Smart Connect" '(("OSMODE") ("CECOLOR")))
(ssg-start (ssg-text "kreisel-start-connect") '(("OSMODE") ("CECOLOR")))
(princ "\n--- Kreisel durch Linie definieren (AN -> SP) ---")
(princ (ssg-text "kreisel-connect-header"))
;; 1. Startpunkt (aeusserster Punkt AN-Seite)
(setq ptStart (getpoint "\nStartpunkt (AN-Seite aussen): "))
(setq ptStart (getpoint (ssg-text "kreisel-prompt-startpunkt")))
(if (null ptStart)
(progn (ssg-end) (princ "\nAbgebrochen.") (princ) (exit))
(progn (ssg-end) (princ (ssg-text "kreisel-abgebrochen")) (princ) (exit))
)
;; 2. Endpunkt (aeusserster Punkt SP-Seite) mit Gummiband
(setq ptEnd (getpoint ptStart "\nEndpunkt (SP-Seite aussen): "))
(setq ptEnd (getpoint ptStart (ssg-text "kreisel-prompt-endpunkt")))
(if (null ptEnd)
(progn (ssg-end) (princ "\nAbgebrochen.") (princ) (exit))
(progn (ssg-end) (princ (ssg-text "kreisel-abgebrochen")) (princ) (exit))
)
;; 3. Geometrie berechnen
@@ -631,8 +628,8 @@
(if (<= abstand 0.0)
(progn
(ssg-emsg (strcat "Distanz zu klein! ("
(rtos dist 2 0) " < " (rtos *kreisel-durchmesser* 2 0) ")"))
(ssg-emsg (ssg-textf "kreisel-emsg-distanz-klein"
(list (rtos dist 2 0) (rtos *kreisel-durchmesser* 2 0))))
(ssg-end)
(exit)
)
@@ -648,26 +645,24 @@
)
(if (<= hoehe 0.0)
(progn
(setq hoehe (getreal (strcat "\nHoehe (Z-Koordinate) <" (rtos *kreisel-default-hoehe* 2 0) ">: ")))
(setq hoehe (getreal (ssg-textf "kreisel-prompt-hoehe-z" (list (rtos *kreisel-default-hoehe* 2 0)))))
(if (null hoehe) (setq hoehe *kreisel-default-hoehe*))
)
(princ (strcat "\n-> Hoehe aus Startpunkt uebernommen: " (rtos hoehe 2 0)))
(princ (ssg-textf "kreisel-hoehe-aus-startpunkt" (list (rtos hoehe 2 0))))
)
;; 6. Kreiselart abfragen
(setq typ (kreisel-ask-typ))
(princ (strcat "\n-> Abstand: " (rtos abstand 2 0) " mm"
" Rotation: " (rtos rotation 2 1) " Grad"
" Hoehe: " (rtos hoehe 2 0)
" Kreiselart: " typ))
(princ (ssg-textf "kreisel-connect-zusammenfassung"
(list (rtos abstand 2 0) (rtos rotation 2 1) (rtos hoehe 2 0) typ)))
;; 7. Modul einfuegen
(draw-module (list (car ptStart) (cadr ptStart) hoehe) abstand rotation
(list (cons "KREISELART" typ)
(cons "HOEHE" (rtos hoehe 2 0))))
(princ "\nKreisel Connect erfolgreich!")
(princ (ssg-text "kreisel-connect-erfolgreich"))
(ssg-end)
)
@@ -684,7 +679,7 @@
;; hoehe : Hoehe in mm (oder nil fuer Z aus pt)
;; Rueckgabe: Entity-Name des erzeugten Blocks oder nil
(defun kreisel-insert-script (pt abstand rotation typ hoehe / z blockEnt)
(ssg-start "Kreisel Script Insert" '(("OSMODE") ("CECOLOR")))
(ssg-start (ssg-text "kreisel-start-script-insert") '(("OSMODE") ("CECOLOR")))
(if (null typ) (setq typ "STANDARD"))
(setq z (if hoehe hoehe
(if (and pt (caddr pt)) (caddr pt) *kreisel-default-hoehe*)))
@@ -703,14 +698,14 @@
;; hoehe : Hoehe in mm (oder nil fuer Z aus ptStart)
;; Rueckgabe: Entity-Name des erzeugten Blocks oder nil
(defun kreisel-connect-script (ptStart ptEnd typ hoehe / dx dy dist abstand rotation z blockEnt)
(ssg-start "Kreisel Script Connect" '(("OSMODE") ("CECOLOR")))
(ssg-start (ssg-text "kreisel-start-script-connect") '(("OSMODE") ("CECOLOR")))
(if (null typ) (setq typ "STANDARD"))
(setq dx (- (car ptEnd) (car ptStart))
dy (- (cadr ptEnd) (cadr ptStart)))
(setq dist (sqrt (+ (* dx dx) (* dy dy))))
(setq abstand (- dist *kreisel-durchmesser*))
(if (<= abstand 0.0)
(progn (princ (strcat "\n[Connect] Distanz zu klein: " (rtos dist 2 0)))
(progn (princ (ssg-textf "kreisel-script-distanz-klein" (list (rtos dist 2 0))))
(ssg-end) nil)
(progn
(setq rotation (* (/ 180.0 pi) (atan dy dx)))
@@ -727,19 +722,19 @@
;; Neue Befehle für Beschriftungs-Einstellungen
(defun c:KreiselLabelPos ( / dx dy)
(setq dx (getreal (strcat "\nX-Abstand von AN8-Mitte <" (rtos *kreisel-beschriftung-abstand-x* 2 0) ">: ")))
(setq dx (getreal (ssg-textf "kreisel-prompt-x-abstand" (list (rtos *kreisel-beschriftung-abstand-x* 2 0)))))
(if dx (setq *kreisel-beschriftung-abstand-x* dx))
(setq dy (getreal (strcat "\nY-Abstand von AN8-Mitte <" (rtos *kreisel-beschriftung-abstand-y* 2 0) ">: ")))
(setq dy (getreal (ssg-textf "kreisel-prompt-y-abstand" (list (rtos *kreisel-beschriftung-abstand-y* 2 0)))))
(if dy (setq *kreisel-beschriftung-abstand-y* dy))
(princ (strcat "\nNeue Beschriftungsposition: X=" (rtos *kreisel-beschriftung-abstand-x* 2 0)
" Y=" (rtos *kreisel-beschriftung-abstand-y* 2 0)))
(princ (ssg-textf "kreisel-neue-beschriftungsposition"
(list (rtos *kreisel-beschriftung-abstand-x* 2 0) (rtos *kreisel-beschriftung-abstand-y* 2 0))))
(princ)
)
(defun c:KreiselLabelHoehe ( / h)
(setq h (getreal (strcat "\nTexthöhe <" (rtos *kreisel-beschriftung-hoehe* 2 0) ">: ")))
(setq h (getreal (ssg-textf "kreisel-prompt-texthoehe" (list (rtos *kreisel-beschriftung-hoehe* 2 0)))))
(if h (setq *kreisel-beschriftung-hoehe* h))
(princ (strcat "\nNeue Texthöhe: " (rtos *kreisel-beschriftung-hoehe* 2 0)))
(princ (ssg-textf "kreisel-neue-texthoehe" (list (rtos *kreisel-beschriftung-hoehe* 2 0))))
(princ)
)
@@ -753,17 +748,17 @@
;; -----------------------------------------------
(defun c:KreiselRedraw ( / sel ent ed attribs basePoint rotation newAbstand)
(ssg-start "Kreisel Neu Zeichnen" '(("CECOLOR")))
(ssg-start (ssg-text "kreisel-start-redraw") '(("CECOLOR")))
;; 1. Bestehenden Kreisel-Block auswaehlen
(setq sel (entsel "\nKreisel-Block auswaehlen: "))
(setq sel (entsel (ssg-text "kreisel-prompt-block-auswaehlen")))
(if (null sel) (exit))
(setq ent (car sel))
(setq ed (entget ent))
;; Pruefen ob INSERT
(if (/= (cdr (assoc 0 ed)) "INSERT")
(progn (ssg-emsg "Kein Block ausgewaehlt!") (exit))
(progn (ssg-emsg (ssg-text "kreisel-emsg-kein-block")) (exit))
)
;; 2. Bestehende Werte auslesen
@@ -772,19 +767,20 @@
(setq rotation (* (/ 180.0 pi) (cdr (assoc 50 ed))))
;; NEU - Höhe aus Attributen lesen und anzeigen:
(princ (strcat "\n-> Bestehend: Abstand=" (cdr (assoc "ABSTAND" attribs))
" Drehung=" (cdr (assoc "DREHUNG" attribs))
" Höhe=" (cdr (assoc "HOEHE" attribs)) ;; <-- NEU
" Art=" (cdr (assoc "KREISELART" attribs))))
(princ (ssg-textf "kreisel-redraw-bestehend"
(list (cdr (assoc "ABSTAND" attribs))
(cdr (assoc "DREHUNG" attribs))
(cdr (assoc "HOEHE" attribs))
(cdr (assoc "KREISELART" attribs)))))
;; 3. Neuen Abstand abfragen (Enter = beibehalten)
(initget 6)
(setq newAbstand (getdist (strcat "\nNeuer Abstand <" (cdr (assoc "ABSTAND" attribs)) ">: ")))
(setq newAbstand (getdist (ssg-textf "kreisel-prompt-neuer-abstand" (list (cdr (assoc "ABSTAND" attribs))))))
(if (null newAbstand)
(setq newAbstand (atof (cdr (assoc "ABSTAND" attribs))))
)
;; NEU - Neue Höhe abfragen:
(setq newHoehe (getreal (strcat "\nNeue Höhe <" (cdr (assoc "HOEHE" attribs)) ">: ")))
(setq newHoehe (getreal (ssg-textf "kreisel-prompt-neue-hoehe" (list (cdr (assoc "HOEHE" attribs))))))
(if (null newHoehe)
(setq newHoehe (atof (cdr (assoc "HOEHE" attribs))))
)
@@ -795,7 +791,7 @@
(draw-module (list (car basePoint) (cadr basePoint) newHoehe)
newAbstand rotation attribs)
(princ (strcat "\nKreisel neu gezeichnet. Abstand=" (rtos newAbstand 2 0)))
(princ (ssg-textf "kreisel-redraw-fertig" (list (rtos newAbstand 2 0))))
(ssg-end)
)
@@ -804,17 +800,17 @@
;; KreiselQuick: Schnell mit Defaults (horizontal)
;; --------------------------------------------
(defun c:KreiselQuick ( / pt)
(ssg-start "Kreisel Schnell Einfuegen" '(("CECOLOR")))
(setq pt (getpoint "\nBasispunkt (AN-Seite): "))
(ssg-start (ssg-text "kreisel-start-quick") '(("CECOLOR")))
(setq pt (getpoint (ssg-text "kreisel-prompt-basispunkt")))
;; NEU - Höhe abfragen:
(setq hoehe (getreal (strcat "\nHöhe (Z-Koordinate) <0>: ")))
(setq hoehe (getreal (ssg-textf "kreisel-prompt-hoehe-z" (list "0"))))
(if (null hoehe) (setq hoehe 0.0))
(if pt
;; NEU - Höhe im Aufruf übergeben:
(draw-module (list (car pt) (cadr pt) hoehe) *kreisel-default-laenge* 0.0
(draw-module (list (car pt) (cadr pt) hoehe) *kreisel-default-laenge* 0.0
(list (cons "HOEHE" (rtos hoehe 2 0))))
)
(princ "\nSchnell Einfuegen fertig.")
(princ (ssg-text "kreisel-quick-fertig"))
(ssg-end)
)
@@ -870,13 +866,13 @@
(setq ent (ssname ss 0))
)
(ssg-start "Kreisel bearbeiten" '(("OSMODE") ("CECOLOR") ("ATTREQ") ("ATTDIA")))
(ssg-start (ssg-text "kreisel-start-edit") '(("OSMODE") ("CECOLOR") ("ATTREQ") ("ATTDIA")))
(setvar "OSMODE" 0)
;; 1. Block auswaehlen (falls nicht vorselektiert)
(if (null ent)
(progn
(setq sel (entsel "\nKreisel-Block auswaehlen: "))
(setq sel (entsel (ssg-text "kreisel-prompt-block-auswaehlen")))
(if sel (setq ent (car sel)))
)
)
@@ -884,7 +880,7 @@
(setq ed (entget ent))
(if (/= (cdr (assoc 0 ed)) "INSERT")
(progn (ssg-emsg "Kein Block ausgewaehlt!") (ssg-end) (exit))
(progn (ssg-emsg (ssg-text "kreisel-emsg-kein-block")) (ssg-end) (exit))
)
;; 2. Bestehende Werte auslesen
@@ -895,7 +891,7 @@
;; Pruefen ob Block Kreisel-Attribute hat (mindestens ABSTAND)
(if (null (assoc "ABSTAND" attribs))
(progn
(ssg-emsg "Kein Kreisel-Block! (Attribut ABSTAND fehlt)")
(ssg-emsg (ssg-text "kreisel-emsg-kein-kreisel-block"))
(ssg-end)
(exit)
)
@@ -912,15 +908,14 @@
(setq attribs (subst (cons "HOEHE" (rtos (if (caddr basePoint) (caddr basePoint) 0.0) 2 1))
(assoc "HOEHE" attribs) attribs))
(princ (strcat "\n-> Bestehend: Abstand=" (cdr (assoc "ABSTAND" attribs))
" Drehung=" (rtos rotation 2 1)
" Art=" (cdr (assoc "KREISELART" attribs))))
(princ (ssg-textf "kreisel-edit-bestehend"
(list (cdr (assoc "ABSTAND" attribs)) (rtos rotation 2 1) (cdr (assoc "KREISELART" attribs)))))
;; 3. DCL-Dialog laden
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/kreisel_edit.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "kreisel_edit" dat))
(progn (alert (strcat "Dialog nicht verfuegbar: " dcl-pfad)) (ssg-end) (exit))
(progn (alert (ssg-textf "kreisel-edit-dialog-fehlt" (list dcl-pfad))) (ssg-end) (exit))
)
;; Ausrichtungs-Labels fuer popup_list aufbauen
@@ -999,13 +994,10 @@
(draw-module (list (car basePoint) (cadr basePoint) (atof dlg-hoehe))
newAbstand newRotation attribs)
(princ (strcat "\nKreisel aktualisiert: "
"Name=" dlg-name
" Abstand=" (rtos newAbstand 2 0)
" Hoehe=" dlg-hoehe
" Rotation=" (rtos newRotation 2 1)))
(princ (ssg-textf "kreisel-edit-aktualisiert"
(list dlg-name (rtos newAbstand 2 0) dlg-hoehe (rtos newRotation 2 1))))
)
(princ "\nAbgebrochen.")
(princ (ssg-text "kreisel-abgebrochen"))
)
(ssg-end)
@@ -1016,13 +1008,13 @@
;; KreiselParams: Aktuelle Parameter anzeigen
;; --------------------------------------------
(defun c:KreiselParams ()
(princ "\n=== Kreisel Parameter ===")
(princ (strcat "\nKreiselart: " #Kreisel_Typ))
(princ (strcat "\nDurchmesser: " (rtos *kreisel-durchmesser* 2 0)))
(princ (strcat "\nDefault-Laenge: " (rtos *kreisel-default-laenge* 2 0)))
(princ (ssg-text "kreisel-params-header"))
(princ (ssg-textf "kreisel-params-typ" (list #Kreisel_Typ)))
(princ (ssg-textf "kreisel-params-durchmesser" (list (rtos *kreisel-durchmesser* 2 0))))
(princ (ssg-textf "kreisel-params-default-laenge" (list (rtos *kreisel-default-laenge* 2 0))))
;; NEU - Default-Höhe anzeigen:
(princ (strcat "\nDefault-Höhe: " (rtos *kreisel-default-hoehe* 2 0)))
(princ "\nAttribute im Block:")
(princ (ssg-textf "kreisel-params-default-hoehe" (list (rtos *kreisel-default-hoehe* 2 0))))
(princ (ssg-text "kreisel-params-attribute-header"))
(foreach def *kreisel-attrib-defs*
(princ (strcat "\n " (car def) " = " (cadr def)))
)
@@ -1045,12 +1037,12 @@
(dbgf "c:ILS_Eckrad")
;; 1. Beruehrpunkt (Tangentenpunkt)
(setq ptTangent (getpoint "\nBeruehrpunkt Eckrad (Tangente): "))
(setq ptTangent (getpoint (ssg-text "kreisel-eckrad-beruehrpunkt")))
(if (null ptTangent) (progn (dbgreturn nil) (exit)))
(dbg 'ptTangent)
;; 2. Richtungspunkt (Gummiband vom Beruehrpunkt)
(setq ptDir (getpoint ptTangent "\nRichtung zum Kreismittelpunkt: "))
(setq ptDir (getpoint ptTangent (ssg-text "kreisel-eckrad-richtung")))
(if (null ptDir) (progn (dbgreturn nil) (exit)))
(dbg 'ptDir)
@@ -1061,7 +1053,7 @@
(if (<= dist (ssg-cfg-or "kreisel" "toleranz_min_distanz" 0.001))
(progn
(princ "\nFehler: Beruehr- und Richtungspunkt sind identisch!")
(princ (ssg-text "kreisel-eckrad-fehler-identisch"))
(dbgreturn nil)
(exit)
)
@@ -1087,10 +1079,10 @@
(if (and (> (length ptTangent) 2) (caddr ptTangent) (> (caddr ptTangent) 0))
(progn
(setq hoehe (caddr ptTangent))
(princ (strcat "\n-> Hoehe aus 3D-Punkt uebernommen: " (rtos hoehe 2 0)))
(princ (ssg-textf "kreisel-hoehe-aus-3dpunkt" (list (rtos hoehe 2 0))))
)
(progn
(setq hoehe (getreal (strcat "\nHoehe (Z-Koordinate) <" (rtos *eckrad-default-hoehe* 2 0) ">: ")))
(setq hoehe (getreal (ssg-textf "kreisel-prompt-hoehe-z" (list (rtos *eckrad-default-hoehe* 2 0)))))
(if (null hoehe) (setq hoehe *eckrad-default-hoehe*))
)
)
@@ -1118,7 +1110,7 @@
(dbg 'pt)
(dbg 'rotation)
(ssg-start "Eckrad einfuegen" '(("ATTREQ") ("ATTDIA") ("OSMODE") ("CECOLOR")))
(ssg-start (ssg-text "kreisel-start-eckrad") '(("ATTREQ") ("ATTDIA") ("OSMODE") ("CECOLOR")))
;; Attribute vorbereiten
(setq attribs (ssg-attrib-merge attribs *eckrad-attrib-defs*))
@@ -1215,14 +1207,14 @@
(dbgp (strcat "Blockdefinition erzeugt: " bname))
)
(progn
(princ "\nFehler: Keine Entities zum Block erstellen!")
(princ (ssg-text "kreisel-fehler-keine-entities"))
(dbgp "FEHLER: Keine Entities fuer Block!")
)
)
(princ (strcat "\n-> Neue Blockdefinition: " bname))
(princ (ssg-textf "kreisel-neue-blockdef" (list bname)))
)
(progn
(princ (strcat "\n-> Verwende bestehende Blockdefinition: " bname))
(princ (ssg-textf "kreisel-bestehende-blockdef" (list bname)))
(dbgp (strcat "Verwende bestehende Blockdefinition: " bname))
)
)
@@ -1259,29 +1251,28 @@
)
(entupd block-ent)
(princ (strcat "\n-> Eckrad #" (itoa eckrad-nummer) " eingefuegt: " bname
" bei " (rtos (car pt) 2 1) "," (rtos (cadr pt) 2 1)
" Rotation=" (rtos rotation 2 1)
" Hoehe=" block-hoehe))
(princ (ssg-textf "kreisel-eckrad-eingefuegt"
(list (itoa eckrad-nummer) bname (rtos (car pt) 2 1) (rtos (cadr pt) 2 1)
(rtos rotation 2 1) block-hoehe)))
(ssg-end)
(dbgreturn (entlast))
)
;; NEU: KreiselLabelSetup - Hier einfügen!
(defun c:KreiselLabelSetup ( / hoehe farbe abstand schriftart)
(setq hoehe (getreal (strcat "\nSchrifthöhe <" (rtos *kreisel-beschriftung-hoehe* 2 0) ">: ")))
(setq hoehe (getreal (ssg-textf "kreisel-prompt-schrifthoehe" (list (rtos *kreisel-beschriftung-hoehe* 2 0)))))
(if hoehe (setq *kreisel-beschriftung-hoehe* hoehe))
(setq farbe (getint (strcat "\nSchriftfarbe (1=Rot,2=Gelb,3=Grün,4=Cyan,5=Blau,6=Magenta,7=Weiß) <" (itoa *kreisel-beschriftung-farbe*) ">: ")))
(setq farbe (getint (ssg-textf "kreisel-prompt-schriftfarbe" (list (itoa *kreisel-beschriftung-farbe*)))))
(if farbe (setq *kreisel-beschriftung-farbe* farbe))
(setq abstand (getreal (strcat "\nAbstand über Kreisel-Mitte <" (rtos *kreisel-beschriftung-abstand-oben* 2 0) ">: ")))
(setq abstand (getreal (ssg-textf "kreisel-prompt-abstand-oben" (list (rtos *kreisel-beschriftung-abstand-oben* 2 0)))))
(if abstand (setq *kreisel-beschriftung-abstand-oben* abstand))
(princ (strcat "\nNeue Einstellungen: Höhe=" (rtos *kreisel-beschriftung-hoehe* 2 0)
", Farbe=" (itoa *kreisel-beschriftung-farbe*)
", Y-Versatz=" (rtos *kreisel-beschriftung-abstand-oben* 2 0)
", Schriftart=Arial"))
(princ (ssg-textf "kreisel-labelsetup-fertig"
(list (rtos *kreisel-beschriftung-hoehe* 2 0)
(itoa *kreisel-beschriftung-farbe*)
(rtos *kreisel-beschriftung-abstand-oben* 2 0))))
(princ)
)
Lisp/OmniModulInsert.lsp
+128 -90
View File
@@ -28,7 +28,7 @@
(setq data-pfad (getenv "DXFM_DATA"))
(if (null data-pfad)
(progn
(princ "\n[OMNI] FEHLER: DXFM_DATA nicht gesetzt!")
(princ (ssg-text "omni-fehler-dxfm-data"))
nil
)
(progn
@@ -242,21 +242,21 @@
;; --- BricsCAD-Befehl: Bogen-Info anzeigen ---
(defun c:OMNI_INFO_BOGEN ( / id eintrag)
(if (null *OMNI-BOEGEN*) (omni:load-data))
(setq id (getstring T "\nSivasId des Bogens eingeben: "))
(if (= id "") (princ "\nAbgebrochen.")
(setq id (getstring T (ssg-text "omni-info-bogen-prompt")))
(if (= id "") (princ (ssg-text "omni-abbruch"))
(progn
;; Versuch als Zahl, dann als String
(setq eintrag (omni:get-bogen (if (/= (atoi id) 0) (atoi id) id)))
(if eintrag
(progn
(princ (strcat "\n ProfilTyp: " (omni:sivasid-to-str (omni:val eintrag "ProfilTyp"))))
(princ (strcat "\n Radius: " (itoa (fix (omni:val eintrag "Radius")))))
(princ (strcat "\n KurvenWinkel: " (rtos (omni:val eintrag "KurvenWinkel") 2 1)))
(princ (strcat "\n Breite: " (itoa (fix (omni:val eintrag "Breite")))))
(princ (strcat "\n Laenge: " (itoa (fix (omni:val eintrag "Länge")))))
(princ (strcat "\n Antriebsart: " (itoa (fix (omni:val eintrag "Antriebsart")))))
(princ (ssg-textf "omni-bogen-info-profiltyp" (list (omni:sivasid-to-str (omni:val eintrag "ProfilTyp")))))
(princ (ssg-textf "omni-bogen-info-radius" (list (itoa (fix (omni:val eintrag "Radius"))))))
(princ (ssg-textf "omni-bogen-info-kurvenwinkel" (list (rtos (omni:val eintrag "KurvenWinkel") 2 1))))
(princ (ssg-textf "omni-bogen-info-breite" (list (itoa (fix (omni:val eintrag "Breite"))))))
(princ (ssg-textf "omni-bogen-info-laenge" (list (itoa (fix (omni:val eintrag "Länge"))))))
(princ (ssg-textf "omni-bogen-info-antriebsart" (list (itoa (fix (omni:val eintrag "Antriebsart"))))))
)
(princ (strcat "\nKein Bogen mit SivasId '" id "' gefunden."))
(princ (ssg-textf "omni-bogen-nicht-gefunden" (list id)))
)
)
)
@@ -267,25 +267,25 @@
;; --- BricsCAD-Befehl: Weichen-Info anzeigen ---
(defun c:OMNI_INFO_WEICHE ( / id eintrag wkl)
(if (null *OMNI-WEICHEN*) (omni:load-data))
(setq id (getstring T "\nSivasId der Weiche eingeben: "))
(if (= id "") (princ "\nAbgebrochen.")
(setq id (getstring T (ssg-text "omni-info-weiche-prompt")))
(if (= id "") (princ (ssg-text "omni-abbruch"))
(progn
(setq eintrag (omni:get-weiche (if (/= (atoi id) 0) (atoi id) id)))
(if eintrag
(progn
(princ (strcat "\n ProfilTyp: " (omni:sivasid-to-str (omni:val eintrag "ProfilTyp"))))
(princ (strcat "\n WeichenTyp: " (omni:sivasid-to-str (omni:val eintrag "WeichenTyp"))))
(princ (ssg-textf "omni-weiche-info-profiltyp" (list (omni:sivasid-to-str (omni:val eintrag "ProfilTyp")))))
(princ (ssg-textf "omni-weiche-info-weichentyp" (list (omni:sivasid-to-str (omni:val eintrag "WeichenTyp")))))
(setq wkl (omni:val eintrag "KurvenWinkel"))
(princ (strcat "\n KurvenWinkel: " (if (= (type wkl) 'INT) (itoa wkl) (rtos wkl 2 1))))
(princ (strcat "\n Schaltungstyp: " (omni:sivasid-to-str (omni:val eintrag "Schaltungstyp"))))
(princ (strcat "\n Breite: " (itoa (fix (omni:val eintrag "Breite")))))
(princ (strcat "\n Laenge: " (itoa (fix (omni:val eintrag "Länge")))))
(princ (strcat "\n KurvenRichtung: " (itoa (fix (omni:val eintrag "KurvenRichtung")))))
(princ (ssg-textf "omni-weiche-info-kurvenwinkel" (list (if (= (type wkl) 'INT) (itoa wkl) (rtos wkl 2 1)))))
(princ (ssg-textf "omni-weiche-info-schaltungstyp" (list (omni:sivasid-to-str (omni:val eintrag "Schaltungstyp")))))
(princ (ssg-textf "omni-weiche-info-breite" (list (itoa (fix (omni:val eintrag "Breite"))))))
(princ (ssg-textf "omni-weiche-info-laenge" (list (itoa (fix (omni:val eintrag "Länge"))))))
(princ (ssg-textf "omni-weiche-info-kurvenrichtung" (list (itoa (fix (omni:val eintrag "KurvenRichtung"))))))
(if (omni:val eintrag "WeichenkörperLänge")
(princ (strcat "\n WK-Laenge: " (rtos (omni:val eintrag "WeichenkörperLänge") 2 1)))
(princ (ssg-textf "omni-weiche-info-wklaenge" (list (rtos (omni:val eintrag "WeichenkörperLänge") 2 1))))
)
)
(princ (strcat "\nKeine Weiche mit SivasId '" id "' gefunden."))
(princ (ssg-textf "omni-weiche-nicht-gefunden" (list id)))
)
)
)
@@ -326,11 +326,13 @@
;; --- Bogen-Auswahl-Dialog oeffnen ---
;; winkel = KurvenWinkel (90, 67.5, 45, 22.5, 180)
;; winkel = KurvenWinkel (90, 67.5, 45, 22.5, 180)
;; init-hoehe / init-drehung = Vorbelegung (optional, fuer Edit-Modus)
;; profiltyp = optionales Praefix zum Filtern des ProfilTyp-Textes,
;; z.B. "APB 60" oder "APB 110" (nil = keine Einschraenkung)
;; Rueckgabe: (eintrag hoehe drehung) oder nil bei Abbruch
(defun omni:bogen-dialog (winkel init-hoehe init-drehung / dcl-pfad dat boegen-liste
profil-liste ergebnis dlg-hoehe dlg-drehung)
(defun omni:bogen-dialog (winkel init-hoehe init-drehung profiltyp / dcl-pfad dat boegen-liste
profil-liste ergebnis dlg-hoehe dlg-drehung profil)
(if (null *OMNI-BOEGEN*) (omni:load-data))
;; Defaults
@@ -339,11 +341,31 @@
;; Boegen nach Winkel filtern
(setq boegen-liste (omni:filter *OMNI-BOEGEN* "KurvenWinkel" winkel))
;; Optional zusaetzlich nach ProfilTyp-Praefix filtern (z.B. "APB 60")
(if profiltyp
(setq boegen-liste
(vl-remove-if-not
'(lambda (e)
(setq profil (cdr (assoc "ProfilTyp" e)))
(and profil (= (vl-string-search profiltyp profil) 0))
)
boegen-liste
)
)
)
(if (null boegen-liste)
(progn
(alert (strcat "Keine Boegen fuer "
(if (= (type winkel) 'INT) (itoa winkel) (rtos winkel 2 1))
" Grad gefunden."))
(alert (ssg-textf "omni-bogen-keine-gefunden"
(list
(strcat
(if (= (type winkel) 'INT) (itoa winkel) (rtos winkel 2 1))
(ssg-text "omni-grad")
)
(if profiltyp (strcat " (" profiltyp ")") "")
)
))
nil
)
(progn
@@ -358,7 +380,7 @@
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/omniflo_boegen.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "omniflo_boegen" dat))
(progn (alert "Bogen-Dialog konnte nicht geladen werden.") nil)
(progn (alert (ssg-text "omni-bogen-dialog-ladefehler")) nil)
(progn
;; Dropdown befuellen
(start_list "bogenart")
@@ -405,47 +427,57 @@
;; ============================================================
;; --- Omniflo / Boegen ---
(defun c:OMNI_APB_630_90 ( / dlg-result)
(setq dlg-result (omni:bogen-dialog 90 nil nil))
(defun c:OMNI_APB60_90 ( / dlg-result)
(setq dlg-result (omni:bogen-dialog 90 nil nil "APB 60"))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[BOGEN] Abgebrochen.")
(princ (ssg-text "omni-abbruch-bogen"))
)
(princ)
)
(defun c:OMNI_APB_630_90 ( / dlg-result)
(setq dlg-result (omni:bogen-dialog 90 nil nil "APB 110"))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ (ssg-text "omni-abbruch-bogen"))
)
(princ)
)
(defun c:OMNI_APB_550_675 ( / dlg-result)
(setq dlg-result (omni:bogen-dialog 67.5 nil nil))
(setq dlg-result (omni:bogen-dialog 67.5 nil nil nil))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[BOGEN] Abgebrochen.")
(princ (ssg-text "omni-abbruch-bogen"))
)
(princ)
)
(defun c:OMNI_APB_630_45 ( / dlg-result)
(setq dlg-result (omni:bogen-dialog 45 nil nil))
(setq dlg-result (omni:bogen-dialog 45 nil nil nil))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[BOGEN] Abgebrochen.")
(princ (ssg-text "omni-abbruch-bogen"))
)
(princ)
)
(defun c:OMNI_APB_550_225 ( / dlg-result)
(setq dlg-result (omni:bogen-dialog 22.5 nil nil))
(setq dlg-result (omni:bogen-dialog 22.5 nil nil nil))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[BOGEN] Abgebrochen.")
(princ (ssg-text "omni-abbruch-bogen"))
)
(princ)
)
(defun c:OMNI_APB_650_180 ( / dlg-result)
(setq dlg-result (omni:bogen-dialog 180 nil nil))
(setq dlg-result (omni:bogen-dialog 180 nil nil nil))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[BOGEN] Abgebrochen.")
(princ (ssg-text "omni-abbruch-bogen"))
)
(princ)
)
@@ -485,7 +517,7 @@
(setq srcAttribs (append srcAttribs (list (cons "ID" ""))))
)
(if (null srcAttribs)
(progn (princ "\n[OMNI] Keine Attribute im Quell-Block gefunden.") nil)
(progn (princ (ssg-text "omni-insert-keine-attribute")) nil)
(progn
;; LAENGEMAX aus Quell-Attribut lesen (falls vorhanden), sonst Parameter
(if (and (assoc "LAENGEMAX" srcAttribs)
@@ -493,9 +525,9 @@
(setq laengemax (atof (cdr (assoc "LAENGEMAX" srcAttribs))))
)
(setq pt (getpoint "\nEinfuegepunkt waehlen: "))
(setq pt (getpoint (ssg-text "omni-prompt-einfuegepunkt")))
(if (null pt)
(progn (princ "\n[OMNI] Abgebrochen.") nil)
(progn (princ (ssg-text "omni-abbruch-omni")) nil)
(progn
(ssg-start "OMNI Aluprofil" '(("OSMODE") ("ATTREQ") ("ATTDIA")))
;; ATTREQ/ATTDIA auf 0 setzen (werden durch ssg-end wiederhergestellt)
@@ -515,22 +547,20 @@
;; 2. Endpunkt fuer Fahrstrecke abfragen (Schleife bei Ueberschreitung)
(setq ok nil)
(while (not ok)
(setq pt2 (getpoint pt "\nEndpunkt der Fahrstrecke waehlen: "))
(setq pt2 (getpoint pt (ssg-text "omni-prompt-endpunkt-fahrstrecke")))
(if (null pt2)
(progn
;; Abbruch: Text loeschen
(command "_.ERASE" textEnt "")
(princ "\n[OMNI] Abgebrochen.")
(princ (ssg-text "omni-abbruch-omni"))
(setq ok T pt nil)
)
(progn
(setq laenge (distance (list (car pt) (cadr pt))
(list (car pt2) (cadr pt2))))
(if (> laenge laengemax)
(alert (strcat "Die gewuenschte Fahrstreckenlaenge von "
(rtos laenge 2 0) " mm ueberschreitet die Maximallaenge von "
(rtos laengemax 2 0) " mm des Fahrstreckenprofils.\n"
"Bitte neu definieren!"))
(alert (ssg-textf "omni-laenge-ueberschritten"
(list (rtos laenge 2 0) (rtos laengemax 2 0))))
(progn
(setq laengeStr (rtos laenge 2 0))
(setq dx (- (car pt2) (car pt))
@@ -604,7 +634,7 @@
(ssg-id-generate blockEnt)
)
(princ (strcat "\n[OMNI] " bname " eingefuegt. Laenge=" laengeStr " mm"))
(princ (ssg-textf "omni-insert-block-eingefuegt" (list bname laengeStr)))
(setq ok T)
)
)
@@ -756,14 +786,16 @@
(if (null basis-liste)
(progn
(alert (strcat "Keine Weichen fuer "
(cond
((null winkel) "alle Winkel")
((= (type winkel) 'INT) (strcat (itoa winkel) " Grad"))
(T (strcat (rtos winkel 2 1) " Grad"))
(alert (ssg-textf "omni-weiche-keine-gefunden"
(list
(cond
((null winkel) (ssg-text "omni-alle-winkel"))
((= (type winkel) 'INT) (strcat (itoa winkel) (ssg-text "omni-grad")))
(T (strcat (rtos winkel 2 1) (ssg-text "omni-grad")))
)
(if weichentyp (strcat " / " weichentyp) "")
)
(if weichentyp (strcat " / " weichentyp) "")
" gefunden."))
))
nil
)
(progn
@@ -779,7 +811,7 @@
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/omniflo_weichen.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "omniflo_weichen" dat))
(progn (alert "Weichen-Dialog konnte nicht geladen werden.") nil)
(progn (alert (ssg-text "omni-weiche-dialog-ladefehler")) nil)
(progn
;; Dropdown befuellen
(start_list "profiltyp")
@@ -844,20 +876,20 @@
(setq omniflo-pfad (getenv "DXFM_OMNIFLO"))
(if (null omniflo-pfad)
(progn
(princ "\n[OMNI] FEHLER: DXFM_OMNIFLO nicht gesetzt!")
(princ (ssg-text "omni-fehler-dxfm-omniflo"))
nil
)
(progn
(setq dxf-pfad (strcat omniflo-pfad "/" sivasnr-str ".dxf"))
(if (not (findfile dxf-pfad))
(progn
(princ (strcat "\n[OMNI] FEHLER: DXF nicht gefunden: " dxf-pfad))
(princ (ssg-textf "omni-fehler-dxf-nicht-gefunden" (list dxf-pfad)))
nil
)
(progn
(setq pt (getpoint "\nEinfuegepunkt waehlen: "))
(setq pt (getpoint (ssg-text "omni-prompt-einfuegepunkt")))
(if (null pt)
(progn (princ "\n[OMNI] Abgebrochen.") nil)
(progn (princ (ssg-text "omni-abbruch-omni")) nil)
(progn
(ssg-start "OMNI DXF Insert" '(("OSMODE") ("ATTREQ") ("ATTDIA")))
(setvar "ATTREQ" 0)
@@ -904,10 +936,13 @@
(ssg-id-generate blockEnt)
)
(princ (strcat "\n[OMNI] " sivasnr-str " eingefuegt."
" Hoehe=" (if hoehe hoehe (ssg-cfg-or "omniflo" "default_hoehe" "2000"))
" Drehung=" (if drehung drehung (ssg-cfg-or "omniflo" "default_drehung" "0"))
(if layer-name (strcat " Layer=" layer-name) "")))
(princ (ssg-textf "omni-dxf-eingefuegt"
(list
sivasnr-str
(if hoehe hoehe (ssg-cfg-or "omniflo" "default_hoehe" "2000"))
(if drehung drehung (ssg-cfg-or "omniflo" "default_drehung" "0"))
(if layer-name (strcat " Layer=" layer-name) "")
)))
(ssg-end)
pt
)
@@ -928,8 +963,8 @@
(setq hoehe (cadr dlg-result))
(setq drehung (caddr dlg-result))
(setq sivasnr-str (omni:sivasid-to-str (omni:val eintrag "Sivasnr")))
(princ (strcat "\n[OMNI] Einfuegen: "
(omni:val eintrag "ProfilTyp") " (" sivasnr-str ")"))
(princ (ssg-textf "omni-einfuegen-info"
(list (omni:val eintrag "ProfilTyp") sivasnr-str)))
(omni:insert-dxf sivasnr-str hoehe drehung)
)
)
@@ -945,7 +980,7 @@
(setq dlg-result (omni:weichen-dialog 90 "Einzelweiche" nil nil))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.")
(princ (ssg-text "omni-abbruch-weiche"))
)
(princ)
)
@@ -954,7 +989,7 @@
(setq dlg-result (omni:weichen-dialog 90 "Doppelweiche" nil nil))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.")
(princ (ssg-text "omni-abbruch-weiche"))
)
(princ)
)
@@ -963,7 +998,7 @@
(setq dlg-result (omni:weichen-dialog 90 "Dreiwegeweiche" nil nil))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.")
(princ (ssg-text "omni-abbruch-weiche"))
)
(princ)
)
@@ -973,7 +1008,7 @@
(setq dlg-result (omni:weichen-dialog 45 "Einzelweiche" nil nil))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.")
(princ (ssg-text "omni-abbruch-weiche"))
)
(princ)
)
@@ -982,7 +1017,7 @@
(setq dlg-result (omni:weichen-dialog 45 "Doppelweiche" nil nil))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.")
(princ (ssg-text "omni-abbruch-weiche"))
)
(princ)
)
@@ -991,7 +1026,7 @@
(setq dlg-result (omni:weichen-dialog 45 "Dreiwegeweiche" nil nil))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.")
(princ (ssg-text "omni-abbruch-weiche"))
)
(princ)
)
@@ -1001,7 +1036,7 @@
(setq dlg-result (omni:weichen-dialog 0 "Einzelweiche" nil nil))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.")
(princ (ssg-text "omni-abbruch-weiche"))
)
(princ)
)
@@ -1010,7 +1045,7 @@
(setq dlg-result (omni:weichen-dialog 0 "Doppelweiche" nil nil))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.")
(princ (ssg-text "omni-abbruch-weiche"))
)
(princ)
)
@@ -1019,7 +1054,7 @@
(setq dlg-result (omni:weichen-dialog 0 "Dreiwegeweiche" nil nil))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.")
(princ (ssg-text "omni-abbruch-weiche"))
)
(princ)
)
@@ -1029,7 +1064,7 @@
(setq dlg-result (omni:weichen-dialog 22.5 "Einzelweiche" nil nil))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.")
(princ (ssg-text "omni-abbruch-weiche"))
)
(princ)
)
@@ -1038,7 +1073,7 @@
(setq dlg-result (omni:weichen-dialog 22.5 "Doppelweiche" nil nil))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.")
(princ (ssg-text "omni-abbruch-weiche"))
)
(princ)
)
@@ -1047,7 +1082,7 @@
(setq dlg-result (omni:weichen-dialog 22.5 "Dreiwegeweiche" nil nil))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.")
(princ (ssg-text "omni-abbruch-weiche"))
)
(princ)
)
@@ -1057,7 +1092,7 @@
(setq dlg-result (omni:weichen-dialog nil "Deltaweiche" nil nil))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.")
(princ (ssg-text "omni-abbruch-weiche"))
)
(princ)
)
@@ -1066,7 +1101,7 @@
(setq dlg-result (omni:weichen-dialog nil "Sternweiche" nil nil))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.")
(princ (ssg-text "omni-abbruch-weiche"))
)
(princ)
)
@@ -1096,7 +1131,7 @@
;; 1. Block auswaehlen (falls nicht vorselektiert)
(if (null ent)
(progn
(setq sel (entsel "\nOmniflo-Element auswaehlen: "))
(setq sel (entsel (ssg-text "omni-edit-prompt-auswahl")))
(if sel (setq ent (car sel)))
)
)
@@ -1104,7 +1139,7 @@
(setq ed (entget ent))
(if (/= (cdr (assoc 0 ed)) "INSERT")
(progn (ssg-emsg "Kein Block ausgewaehlt!") (ssg-end) (exit))
(progn (ssg-emsg (ssg-text "omni-edit-kein-block")) (ssg-end) (exit))
)
;; 2. Bestehende Attribute lesen
@@ -1160,7 +1195,7 @@
(if (null eintrag)
(progn
(ssg-emsg "Kein Omniflo-Element erkannt! (ARTINR/Blockname nicht im Katalog)")
(ssg-emsg (ssg-text "omni-edit-kein-element"))
(ssg-end)
(exit)
)
@@ -1171,7 +1206,7 @@
(if (= typ "bogen")
(progn
(setq winkel (cdr (assoc "KurvenWinkel" eintrag)))
(setq dlg-result (omni:bogen-dialog winkel hoehe drehung))
(setq dlg-result (omni:bogen-dialog winkel hoehe drehung nil))
)
(progn
(setq winkel (cdr (assoc "KurvenWinkel" eintrag)))
@@ -1181,7 +1216,7 @@
)
(if (null dlg-result)
(progn (princ "\nAbgebrochen.") (ssg-end) (exit))
(progn (princ (ssg-text "omni-abbruch")) (ssg-end) (exit))
)
;; 5. Neuen Eintrag und Werte extrahieren
@@ -1194,7 +1229,7 @@
(setq dxf-pfad (strcat (getenv "DXFM_OMNIFLO") "/" sivasnr-str ".dxf"))
(if (not (findfile dxf-pfad))
(progn
(ssg-emsg (strcat "DXF nicht gefunden: " dxf-pfad))
(ssg-emsg (ssg-textf "omni-edit-dxf-nicht-gefunden" (list dxf-pfad)))
(ssg-end)
(exit)
)
@@ -1223,9 +1258,12 @@
(cons "DREHUNG" (if new-drehung new-drehung (ssg-cfg-or "omniflo" "default_drehung" "0")))))
)
(princ (strcat "\n[OMNI] Element aktualisiert: " sivasnr-str
" Hoehe=" (if new-hoehe new-hoehe (ssg-cfg-or "omniflo" "default_hoehe" "2000"))
" Drehung=" (if new-drehung new-drehung (ssg-cfg-or "omniflo" "default_drehung" "0"))))
(princ (ssg-textf "omni-edit-aktualisiert"
(list
sivasnr-str
(if new-hoehe new-hoehe (ssg-cfg-or "omniflo" "default_hoehe" "2000"))
(if new-drehung new-drehung (ssg-cfg-or "omniflo" "default_drehung" "0"))
)))
(ssg-end)
(princ)
Lisp/README.md
+64 -4
View File
@@ -15,7 +15,7 @@ _MENULOAD → menu/SSG_LIB.mnu auswaehlen
```
BricsCAD laedt daraufhin automatisch `SSG_LIB.mnl`, welches alle Module
per `ssg-ensure` initialisiert (Kern: ssg_core/dbg/dialog/layer, dann
per `ssg-ensure` initialisiert (Kern: ssg_core/lang/dbg/dialog/layer, dann
alle Feature-Module). Details: siehe `../CLAUDE.md` Abschnitt "Lademechanismus".
**Manuell laden (Notfall / Entwicklung):**
@@ -26,6 +26,28 @@ alle Feature-Module). Details: siehe `../CLAUDE.md` Abschnitt "Lademechanismus".
---
## Status: noch offene Menueintraege (im Menue ausgegraut)
Die folgenden Menueintraege rufen aktuell nur eine Dummy-Funktion auf (Meldung
`[DUMMY]`, keine Geometrie). Sie sind in `menu/SSG_LIB.mnu` mit `~` **ausgegraut**
und werden erst bei echter Implementierung wieder aktiviert. Der `~`-Marker steht
am Label-Anfang, bei Submenue-Schliessern hinter dem `<-` (`[<-~Label]`).
| Menuebereich | Eintraege | Definiert in |
| --- | --- | --- |
| ILS ▸ Zusatzmodul | BTMT-Beladung, BTMT-Entladung | `SSG_LIB_Commands.lsp` |
| ILS ▸ Foerderer | Durch TEF angetriebene Strecke; Kurven 90/60/30 links/rechts angetrieben Aussen + Innen (12) | `SSG_LIB_Commands.lsp` |
| ILS ▸ Gefaellestrecke | Kurven 90/60/30 links/rechts Gefaellestrecke (6) | `SSG_LIB_Commands.lsp` |
| Omniflo ▸ TEF Elemente | UmlenkR/L, AntriebL/R, TEF Gerade, KettenFoerderer (6) | `OmniModulInsert.lsp` |
| Omniflo ▸ Verbinder | alle `OMNI_TV_*` (18) | `OmniModulInsert.lsp` |
| Omniflo ▸ Boegen fuer Weichen | alle `OMNI_APBW_*` (14) | `OmniModulInsert.lsp` |
Aktiv (implementiert) sind u.a.: Kreisel, Eckrad, VarioFoerderer, EtageVarioFoerderer,
Gefaellestrecke, Omniflo Boegen (APB), Aluprofil-Geraden (AP), alle Weichen
(W90/W45/WP/WK/WKomb), Export (Sivas/CSV) und die Tests.
---
## Dateien
### `ssg_core.lsp` – Kernbibliothek
@@ -111,6 +133,20 @@ Interne Parser-Funktionen (nicht direkt aufrufen):
---
### `ssg_lang.lsp` – Sprachumschaltung (Deutsch/Englisch)
Zentrale Textverwaltung fuer benutzersichtbare Meldungen. Kern-Modul, wird direkt nach `ssg_core` geladen. Wird schrittweise auf weitere Module ausgerollt (siehe `doc/translate.md`).
| Funktion | Beschreibung |
| --- | --- |
| `ssg-text key` | Liefert Text zu `key` in `*ssg-lang*`, Fallback `de_DE`, dann Key selbst |
| `ssg-textf key werte` | Wie `ssg-text`, ersetzt Platzhalter `%1 %2 ...` durch `werte` (Liste) |
Sprache umschalten: Befehl `SSG_SPRACHE` (Menue → Konfiguration → Sprache) setzt `*ssg-lang*`
live und persistiert via `(setenv "DXFM_LANG" ...)`. Default ohne `DXFM_LANG` ist `"de_DE"`.
---
### `ssg_dbg.lsp` – Debug-Logging
Dateibasiertes Debug-Log mit gepuffertem Schreiben. `dbgf`/`dbg`/`dbgmsg` puffern im Speicher, `dbgreturn` flusht auf die Platte (open/append/close).
@@ -248,6 +284,21 @@ Der Omniflo-CSV-Export (Bogen/Weiche/Gerade, inkl. Merkmale-Aufbau und Sum-Zeile
seit Entfernung von `c:OMNI_EXPORT` ausschließlich über `c:EXPORTCSV` → `lib/export_csv.py`
(`build_bogen_merkmale`, `build_weiche_merkmale`, `build_gerade_merkmale`, `build_omni_sum_merkmale`).
**Ausgabeordner:** `c:EXPORTSIVAS`/`c:EXPORTCSV` schreiben immer nach `DXFM_RESULTS`.
`TEST_EXPORT_ALL` (siehe `tests/test_export_all.lsp`) leitet waehrend des Testlaufs stattdessen
nach `DXFM_TESTOUT` um, über die reine Lisp-Sitzungsvariable `*export-test-override*` (wird von
`csv:run-export` zusaetzlich zu `DXFM_RESULTS` abgefragt und danach garantiert wieder auf `nil`
zurueckgesetzt, auch bei einem Fehler, ueber `vl-catch-all-apply`).
**Wichtig:** Der Umweg über `*export-test-override*` ist bewusst gewaehlt und **kein**
`(setenv "DXFM_RESULTS" ...)`. In BricsCAD/AutoCAD schreibt `(setenv ...)` nicht nur in den
Windows-Prozess, sondern dauerhaft in die Profil-Registry der Anwendung – der Wert überlebt
damit jeden Neustart und jedes `setenv.bat`, bis er erneut per `(setenv)` überschrieben wird.
Ein einziger `(setenv "DXFM_RESULTS" ...)`-Aufruf (z. B. ein frueherer, unvollstaendiger
Testlauf) würde `DXFM_RESULTS` für alle künftigen Sitzungen unwiderruflich auf den Testordner
umbiegen. Falls das bereits passiert ist, hilft nur ein manuelles
`(setenv "DXFM_RESULTS" "<richtiger Pfad>")` in BricsCAD, um den Profil-Wert zu korrigieren.
---
### `tests.lsp` – Testbefehle
@@ -289,9 +340,9 @@ AutoLISP-Implementierung fuer alle Omniflo-Komponenten: Boegen, Weichen, Verbind
| Boegen | `OMNI_APB_630_90`, `OMNI_APB_550_675`, `OMNI_APB_630_45`, `OMNI_APB_550_225`, `OMNI_APB_650_180` | Omniflo-Boegen ueber DCL-Dialog einfuegen |
| Weichen | `OMNI_W90_*`, `OMNI_W45_*`, `OMNI_WP_*`, `OMNI_WK_*`, `OMNI_WKomb_*` | Omniflo-Weichen (Einfach/Doppel/Dreiwege, Delta, Stern) |
| Geraden | `OMNI_AP60`, `OMNI_AP110`, `OMNI_APG110` | Omniflo-Geradenstuecke |
| TEF | `OMNI_TEF_UmlenkR/L`, `OMNI_TEF_AntriebL/R`, `OMNI_TEF_Gerade` | Omniflo-TEF-Elemente |
| Transferwagen | `OMNI_TV_*` | Transferwagen-Komponenten und Schaltwerke |
| Bogenweichen | `OMNI_APBW_*` | Omniflo-Bogenweichen (diverse Radien/Winkel) |
| TEF ⚠️ | `OMNI_TEF_UmlenkR/L`, `OMNI_TEF_AntriebL/R`, `OMNI_TEF_Gerade`, `OMNI_KettenFoerderer` | **Dummy** (noch nicht implementiert, im Menue ausgegraut) |
| Transferwagen ⚠️ | `OMNI_TV_*` | **Dummy** (noch nicht implementiert, im Menue ausgegraut) |
| Bogenweichen ⚠️ | `OMNI_APBW_*` | **Dummy** (noch nicht implementiert, im Menue ausgegraut) |
| Bearbeiten | `OMNI_EDIT` | Omniflo-Block selektieren und Attribute bearbeiten |
---
@@ -299,6 +350,8 @@ AutoLISP-Implementierung fuer alle Omniflo-Komponenten: Boegen, Weichen, Verbind
### `SSG_LIB_Commands.lsp` – Dummy-Befehle und SSG_BLOCKEDIT
Platzhalter-Definitionen fuer noch nicht implementierte Menueintraege. Gibt beim Aufruf eine Meldung aus.
Alle zugehoerigen Menueintraege sind in `menu/SSG_LIB.mnu` mit `~` ausgegraut (siehe
Abschnitt ["Status: noch offene Menueintraege"](#status-noch-offene-menueintraege-im-menue-ausgegraut)).
Registrierte Dummy-Befehle:
@@ -311,6 +364,13 @@ Registrierte Dummy-Befehle:
> `FOERDERANLAGE` ist nicht hier definiert – dieser Befehl ist in `VarioFoerderer.lsp` implementiert.
**Konfigurationsbefehle** (Menue → Konfiguration):
| Befehl | Beschreibung |
| --- | --- |
| `SSG_DIM_SWITCH` | Schaltet zwischen 2D/3D-Bloecken um (setzt `DXFM_DIM`, `DXFM_BLOCKS`, `DXFM_OMNIFLO`) |
| `SSG_SPRACHE` | Oeffnet Dialog `sprache.dcl`, setzt `*ssg-lang*` und persistiert via `DXFM_LANG` (siehe [`ssg_lang.lsp`](#ssg_langlsp--sprachumschaltung-deutschenglisch)) |
**SSG_BLOCKEDIT** – Doppelklick/Kontextmenue-Dispatcher:
Erkennt den Blocktyp des selektierten INSERT-Blocks und ruft den passenden Bearbeitungsbefehl auf:
Lisp/SSG_LIB_Commands.lsp
+42 -10
View File
@@ -132,9 +132,41 @@
(setenv "DXFM_DIM" dim-neu)
(setenv "DXFM_BLOCKS" (strcat basis "\\data\\ils\\" dim-neu))
(setenv "DXFM_OMNIFLO" (strcat basis "\\data\\omniflo\\" dim-neu))
(princ (strcat "\nModus umgeschaltet auf: " dim-neu))
(princ (strcat "\n DXFM_BLOCKS = " (getenv "DXFM_BLOCKS")))
(princ (strcat "\n DXFM_OMNIFLO = " (getenv "DXFM_OMNIFLO")))
(princ (ssg-textf "dim-switch-modus" (list dim-neu)))
(princ (ssg-textf "dim-switch-blocks" (list (getenv "DXFM_BLOCKS"))))
(princ (ssg-textf "dim-switch-omniflo" (list (getenv "DXFM_OMNIFLO"))))
(princ)
)
;; ============================================================
;; SSG_SPRACHE - Sprache umschalten (Deutsch/Englisch)
;; Setzt *ssg-lang* live und persistiert ueber DXFM_LANG
;; ============================================================
(defun ssg-sprache-init ( / idx)
(start_list "sprache")
(add_list "Deutsch")
(add_list "Englisch")
(end_list)
(setq idx (if (= *ssg-lang* "en_GB") "1" "0"))
(set_tile "sprache" idx)
)
(defun ssg-sprache-accept ( / idx neu)
(setq idx (get_tile "sprache"))
(setq neu (if (= idx "1") "en_GB" "de_DE"))
(setq *ssg-lang* neu)
(setenv "DXFM_LANG" neu)
)
(defun c:SSG_SPRACHE ()
(ssg-dialog-run
(strcat (getenv "DXFM_DCL") "/sprache.dcl")
"sprache"
'ssg-sprache-init
'ssg-sprache-accept
)
(princ (ssg-textf "sprache-gewechselt" (list *ssg-lang*)))
(princ)
)
@@ -149,13 +181,13 @@
(setq ss (ssget "I"))
(if (or (null ss) (/= (sslength ss) 1))
(progn
(princ "\nBlock auswaehlen: ")
(princ (ssg-text "cmd-block-auswaehlen"))
(setq ss (ssget ":S" '((0 . "INSERT"))))
)
)
(if (null ss)
(progn
(princ "\nKein Block ausgewaehlt.")
(princ (ssg-text "cmd-kein-block-ausgewaehlt"))
(princ)
(exit)
)
@@ -166,7 +198,7 @@
(if (/= (cdr (assoc 0 ed)) "INSERT")
(progn
(princ "\nKein Block ausgewaehlt.")
(princ (ssg-text "cmd-kein-block-ausgewaehlt"))
(princ)
(exit)
)
@@ -177,13 +209,13 @@
(cond
;; Kreisel-Bloecke -> KreiselEdit
((wcmatch bname "KREISEL_*")
(princ (strcat "\nKreisel bearbeiten: " bname))
(princ (ssg-textf "cmd-kreisel-bearbeiten" (list bname)))
(c:KreiselEdit)
)
;; Eckrad-Bloecke -> BEDIT (kein eigener Edit-Dialog in LISP)
((wcmatch bname "ECKRAD_*")
(princ (strcat "\nEckrad bearbeiten: " bname))
(princ (ssg-textf "cmd-eckrad-bearbeiten" (list bname)))
(command "_.BEDIT" bname)
)
@@ -198,13 +230,13 @@
(wcmatch bname "#*")
)
)
(princ (strcat "\nOmniflo Element bearbeiten: " bname))
(princ (ssg-textf "cmd-omniflo-bearbeiten" (list bname)))
(c:OMNI_EDIT)
)
;; Unbekannter Blocktyp -> natives EATTEDIT (Attribut-Editor)
(t
(princ (strcat "\nAttribute bearbeiten: " bname))
(princ (ssg-textf "cmd-attribute-bearbeiten" (list bname)))
(command "_.EATTEDIT")
)
)
Lisp/VarioFoerderer.lsp
+1 -1
View File
@@ -17,5 +17,5 @@
)
(if *vf-core-datei*
(load *vf-core-datei*)
(princ "\n[VarioFoerderer] WARNUNG: vf_core.lsp nicht gefunden - Befehle nicht verfuegbar.")
(princ (ssg-text "vfstart-core-nicht-gefunden"))
)
Lisp/addattribute.lsp
+272
View File
@@ -0,0 +1,272 @@
;; ============================================================
;; addattribute.lisp
;; Synchronisiert ATTDEF-Attribute in den ILS-Block-DWGs mit den
;; Werten aus allocations.json.
;;
;; Es wird zwischen data/ils/2D und data/ils/3D unterschieden: nach
;; Auswahl des Verzeichnisses wird die dortige allocations.json
;; gelesen (data/ils/<2D|3D>/allocations.json) und anschliessend
;; werden ausschliesslich die DWGs in genau diesem Verzeichnis
;; bearbeitet.
;;
;; Ablauf je JSON-Eintrag "Blockname": {"TAG": "Wert", ...}:
;; - <Blockname>.dwg im selben Verzeichnis wie die JSON oeffnen
;; - je Attribut (TAG/Wert):
;; - ATTDEF mit diesem Tag existiert nicht -> neu anlegen,
;; Vorgabewert = JSON-Wert (auch wenn dieser leer ist)
;; - ATTDEF existiert, ist aber leer -> mit JSON-Wert befuellen
;; - ATTDEF existiert und ist bereits befuellt
;; -> NUR ueberschreiben,
;; wenn der JSON-Wert NICHT leer ("") ist. Ein leerer JSON-Wert
;; loescht also nie einen bereits vorhandenen Wert.
;; - DWG nur dann speichern, wenn sich mindestens ein Attributwert
;; geaendert hat oder neu angelegt wurde (bessere Nachverfolgbarkeit
;; im Versionsvergleich). Falls durch dieses Skript geoeffnet, wird
;; die DWG anschliessend wieder geschlossen. War die DWG schon vorher
;; offen, bleibt sie offen.
;;
;; Voraussetzung: DXFM_DATA ist gesetzt (siehe bin/setenv.bat).
;;
;; Aufruf in BricsCAD:
;; (load "C:/.../data/ils/2D/addattribute.lisp")
;; ILS_ATTR_SYNC
;; ============================================================
(vl-load-com)
;; ssg_core.lsp (JSON-Parser ssg-cfg-parse-nested) sicherstellen,
;; falls das Menue/die Kern-Module noch nicht geladen wurden.
(if (not (car (atoms-family 1 '("SSG-CFG-PARSE-NESTED"))))
(if (getenv "DXFM_LISP")
(load (strcat (vl-string-translate "\\" "/" (getenv "DXFM_LISP")) "/ssg_core.lsp"))
)
)
;; ------------------------------------------------------------
;; Bereits offenes Dokument mit gegebenem Pfad suchen (oder nil)
;; ------------------------------------------------------------
(defun iad-find-open-doc (dwg-pfad / docs anzahl i doc full treffer)
(setq docs (vla-get-Documents (vlax-get-acad-object))
anzahl (vla-get-Count docs)
i 0
treffer nil
dwg-pfad (strcase (vl-string-translate "\\" "/" dwg-pfad))
)
(while (and (< i anzahl) (not treffer))
(setq doc (vla-item docs i))
(setq full (strcase (vl-string-translate "\\" "/" (vla-get-FullName doc))))
(if (= full dwg-pfad) (setq treffer doc))
(setq i (1+ i))
)
treffer
)
;; ------------------------------------------------------------
;; Ein einzelnes ATTDEF aktualisieren (Ueberschreib-Regel)
;; Rueckgabe: t, wenn der Wert tatsaechlich geaendert wurde
;; ------------------------------------------------------------
(defun iad-update-attdef (ent jsonwert / ed altwert)
(setq ed (entget ent)
altwert (cdr (assoc 1 ed))
)
(if (null altwert) (setq altwert ""))
(cond
((equal altwert jsonwert)
(princ (strcat "\n = " (cdr (assoc 2 ed)) " = '" altwert "' (unveraendert)"))
nil
)
((or (= (strlen altwert) 0) (> (strlen jsonwert) 0))
(entmod (subst (cons 1 jsonwert) (assoc 1 ed) ed))
(princ (strcat "\n - " (cdr (assoc 2 ed)) " = '" jsonwert "'"))
t
)
(t
(princ (strcat "\n = " (cdr (assoc 2 ed)) " = '" altwert "' (unveraendert, JSON-Wert leer)"))
nil
)
)
)
;; ------------------------------------------------------------
;; Neues (unsichtbares) ATTDEF anlegen
;; ------------------------------------------------------------
(defun iad-create-attdef (tag wert ypos texthoehe layer)
(entmake (list
'(0 . "ATTDEF")
(cons 8 layer)
(cons 10 (list 0.0 ypos 0.0))
(cons 40 texthoehe)
(cons 1 wert)
(cons 3 tag)
(cons 2 tag)
'(70 . 1)
))
(princ (strcat "\n + " tag " = '" wert "' (neu angelegt)"))
)
;; ------------------------------------------------------------
;; Alle Attribute eines JSON-Eintrags im aktiven Dokument abgleichen
;; attribs = (("TAG" . "Wert") ...)
;; Rueckgabe: t, wenn mindestens ein Attribut geaendert/neu angelegt wurde
;; ------------------------------------------------------------
(defun iad-sync-attribs-in-current-doc (attribs / texthoehe layer ss anzahl i ent ed
tag wert pt vorhandene ypos gefunden paar geaendert)
(setq texthoehe (ssg-cfg-or "ils_attribut" "texthoehe" 50.0)
layer (ssg-cfg-or "ils_attribut" "layer" "0")
vorhandene nil
ypos 0.0
geaendert nil
)
;; Vorhandene ATTDEFs einsammeln (Tag -> Entity) und tiefsten Y-Wert merken
(setq ss (ssget "X" '((0 . "ATTDEF"))))
(if ss
(progn
(setq i 0 anzahl (sslength ss))
(while (< i anzahl)
(setq ent (ssname ss i)
ed (entget ent)
tag (cdr (assoc 2 ed))
pt (cdr (assoc 10 ed))
)
(setq vorhandene (cons (cons tag ent) vorhandene))
(if (and pt (< (cadr pt) ypos)) (setq ypos (cadr pt)))
(setq i (1+ i))
)
)
)
(setq ypos (- ypos (* texthoehe 2.0)))
(foreach paar attribs
(setq tag (car paar)
wert (cdr paar)
)
(if (null wert) (setq wert ""))
(setq gefunden (cdr (assoc tag vorhandene)))
(if gefunden
(if (iad-update-attdef gefunden wert) (setq geaendert t))
(progn
(iad-create-attdef tag wert ypos texthoehe layer)
(setq ypos (- ypos (* texthoehe 2.0)))
(setq geaendert t)
)
)
)
geaendert
)
;; ------------------------------------------------------------
;; Hauptbefehl
;; ------------------------------------------------------------
(defun c:ILS_ATTR_SYNC ( / data-dir json-pfad dwg-dir dwg-unterverz daten orig-doc anzahl-aktualisiert
anzahl-unveraendert anzahl-fehler anzahl-fehlt eintrag blockname attribs
dwg-pfad bereits-offen fehler fehlende-liste name)
(setq data-dir (getenv "DXFM_DATA"))
(if (not data-dir)
(progn
(alert "DXFM_DATA ist nicht gesetzt.\nBitte zuerst bin/setenv.bat ausfuehren.")
(exit)
)
)
(setq data-dir (vl-string-translate "\\" "/" data-dir))
(initget "2D 3D")
(setq dwg-unterverz (getkword "\nDWG-Verzeichnis waehlen [2D/3D] <2D>: "))
(if (not dwg-unterverz) (setq dwg-unterverz "2D"))
(setq dwg-dir (strcat data-dir "/ils/" dwg-unterverz)
json-pfad (strcat dwg-dir "/allocations.json")
)
(if (not (findfile json-pfad))
(progn
(alert (strcat "JSON nicht gefunden:\n" json-pfad))
(exit)
)
)
(setq daten (ssg-cfg-parse-nested (ssg-read-file-lines json-pfad)))
(if (not daten)
(progn
(alert "JSON konnte nicht gelesen werden oder ist leer.")
(exit)
)
)
(setq orig-doc (vla-get-ActiveDocument (vlax-get-acad-object))
anzahl-aktualisiert 0
anzahl-unveraendert 0
anzahl-fehler 0
anzahl-fehlt 0
fehlende-liste nil
)
(foreach eintrag daten
(setq blockname (car eintrag)
attribs (cdr eintrag)
dwg-pfad (strcat dwg-dir "/" blockname ".dwg")
)
(if (findfile dwg-pfad)
(progn
(princ (strcat "\n[ATTR-SYNC] Bearbeite " blockname ".dwg ..."))
(setq bereits-offen (iad-find-open-doc dwg-pfad))
(setq fehler
(vl-catch-all-apply
(function
(lambda ( / geaendert)
(if bereits-offen
(progn
(vlax-put-property (vlax-get-acad-object) 'ActiveDocument bereits-offen)
(setq geaendert (iad-sync-attribs-in-current-doc attribs))
)
(progn
(command "_.OPEN" dwg-pfad)
(setq geaendert (iad-sync-attribs-in-current-doc attribs))
)
)
(if geaendert
(command "_.QSAVE")
(princ "\n (keine Aenderungen, DWG nicht gespeichert)")
)
(if (not bereits-offen) (command "_.CLOSE"))
geaendert
)
)
nil
)
)
(if (vl-catch-all-error-p fehler)
(progn
(princ (strcat "\n[ATTR-SYNC] FEHLER bei " blockname ".dwg: "
(vl-catch-all-error-message fehler)))
(setq anzahl-fehler (1+ anzahl-fehler))
)
(if fehler
(setq anzahl-aktualisiert (1+ anzahl-aktualisiert))
(setq anzahl-unveraendert (1+ anzahl-unveraendert))
)
)
)
(progn
(setq anzahl-fehlt (1+ anzahl-fehlt))
(setq fehlende-liste (cons (strcat blockname ".dwg") fehlende-liste))
)
)
)
(vlax-put-property (vlax-get-acad-object) 'ActiveDocument orig-doc)
(princ (strcat "\n[ATTR-SYNC] Fertig: " (itoa anzahl-aktualisiert) " DWG(s) aktualisiert, "
(itoa anzahl-unveraendert) " ueberprueft (keine Aenderungen), "
(itoa anzahl-fehler) " Fehler, "
(itoa anzahl-fehlt) " nicht gefunden."))
(if fehlende-liste
(progn
(princ "\n[ATTR-SYNC] WARNUNG: DWG nicht gefunden fuer:")
(foreach name (reverse fehlende-liste)
(princ (strcat "\n - " name))
)
)
)
(princ)
)
(princ "\naddattribute.lisp geladen. Befehl: ILS_ATTR_SYNC")
(princ)
Lisp/collect_attributes.lsp
+243
View File
@@ -0,0 +1,243 @@
;; ============================================================
;; collect_attributes.lsp
;; Sammelt die aktuellen ATTDEF-Werte aller Bloecke (DWG-Dateien)
;; eines Verzeichnisses und schreibt sie als JSON-Datei
;; "allocations_collected.json" - im selben Format wie
;; allocations.json (siehe addattribute.lsp):
;; {"Blockname": {"TAG1": "Wert1", "TAG2": "Wert2", ...}, ...}
;;
;; Wird zunaechst fuer data/ils/2D und data/ils/3D ausgefuehrt -
;; je Verzeichnis entsteht eine eigene allocations_collected.json,
;; direkt im jeweiligen Verzeichnis abgelegt.
;;
;; Voraussetzung: DXFM_DATA ist gesetzt (siehe bin/setenv.bat).
;;
;; Aufruf in BricsCAD:
;; (load "C:/.../Lisp/collect_attributes.lsp")
;; ILS_ATTR_COLLECT
;; ============================================================
(vl-load-com)
;; ------------------------------------------------------------
;; Bereits offenes Dokument mit gegebenem Pfad suchen (oder nil)
;; ------------------------------------------------------------
(defun cac-find-open-doc (dwg-pfad / docs anzahl i doc full treffer)
(setq docs (vla-get-Documents (vlax-get-acad-object))
anzahl (vla-get-Count docs)
i 0
treffer nil
dwg-pfad (strcase (vl-string-translate "\\" "/" dwg-pfad))
)
(while (and (< i anzahl) (not treffer))
(setq doc (vla-item docs i))
(setq full (strcase (vl-string-translate "\\" "/" (vla-get-FullName doc))))
(if (= full dwg-pfad) (setq treffer doc))
(setq i (1+ i))
)
treffer
)
;; ------------------------------------------------------------
;; String fuer JSON escapen (Anfuehrungszeichen/Backslash)
;; ------------------------------------------------------------
(defun cac-json-escape (s)
(if (null s) (setq s ""))
(setq s (vl-string-subst "\\\\" "\\" s))
(vl-string-subst "\\\"" "\"" s)
)
;; ------------------------------------------------------------
;; Alle ATTDEFs im aktiven Dokument einsammeln (alphabetisch nach
;; Tag sortiert, fuer reproduzierbare Ausgabe) -> (("TAG" . "Wert") ...)
;; ------------------------------------------------------------
(defun cac-collect-attdefs-in-current-doc ( / ss anzahl i ent ed tag wert ergebnis)
(setq ss (ssget "X" '((0 . "ATTDEF"))))
(setq ergebnis nil)
(if ss
(progn
(setq i 0 anzahl (sslength ss))
(while (< i anzahl)
(setq ent (ssname ss i)
ed (entget ent)
tag (cdr (assoc 2 ed))
wert (cdr (assoc 1 ed))
)
(if (null wert) (setq wert ""))
(setq ergebnis (cons (cons tag wert) ergebnis))
(setq i (1+ i))
)
)
)
(vl-sort ergebnis (function (lambda (a b) (< (strcase (car a)) (strcase (car b))))))
)
;; ------------------------------------------------------------
;; Attribut-Alist ((TAG . Wert) ...) als eingerueckten JSON-Objekt-
;; Text formatieren, z.B.:
;; {
;; "TAG1": "Wert1",
;; "TAG2": "Wert2"
;; }
;; einruecken = Einrueckung der schliessenden Klammer
;; ------------------------------------------------------------
(defun cac-attribs-to-json (attribs einruecken / innen zeilen)
(if (null attribs)
"{}"
(progn
(setq innen (strcat einruecken " "))
(setq zeilen
(mapcar
(function (lambda (paar)
(strcat innen "\"" (cac-json-escape (car paar)) "\": \""
(cac-json-escape (cdr paar)) "\"")
))
attribs
)
)
(strcat "{\n"
(car zeilen)
(apply 'strcat (mapcar (function (lambda (z) (strcat ",\n" z))) (cdr zeilen)))
"\n" einruecken "}"
)
)
)
)
;; ------------------------------------------------------------
;; Eine DWG-Datei oeffnen (falls noetig), ATTDEFs einsammeln und
;; die Datei wieder schliessen (falls durch diese Funktion geoeffnet).
;; Rueckgabe: ('ok . (("TAG" . "Wert") ...)) oder ('fehler . meldung)
;; ------------------------------------------------------------
(defun cac-collect-dwg (dwg-pfad / bereits-offen ergebnis fehler)
(setq bereits-offen (cac-find-open-doc dwg-pfad))
(setq ergebnis nil)
(setq fehler
(vl-catch-all-apply
(function
(lambda ()
(if bereits-offen
(vlax-put-property (vlax-get-acad-object) 'ActiveDocument bereits-offen)
(command "_.OPEN" dwg-pfad)
)
(setq ergebnis (cac-collect-attdefs-in-current-doc))
(if (not bereits-offen) (command "_.CLOSE"))
)
)
nil
)
)
(if (vl-catch-all-error-p fehler)
(cons 'fehler (vl-catch-all-error-message fehler))
(cons 'ok ergebnis)
)
)
;; ------------------------------------------------------------
;; Alle *.dwg eines Verzeichnisses einlesen und als
;; allocations_collected.json (json-pfad) schreiben.
;; ------------------------------------------------------------
(defun cac-collect-directory (dwg-dir json-pfad / dateien datei dwg-pfad orig-doc
blockname ergebnis anzahl-ok anzahl-fehler
fehler-liste eintraege fh erste paar)
(setq dwg-dir (vl-string-right-trim "/" (vl-string-translate "\\" "/" dwg-dir)))
(if (not (findfile dwg-dir))
(princ (strcat "\n[ATTR-COLLECT] Verzeichnis nicht gefunden, uebersprungen: " dwg-dir))
(progn
(setq dateien (vl-directory-files dwg-dir "*.dwg" 1))
(if (not dateien)
(princ (strcat "\n[ATTR-COLLECT] Keine DWG-Dateien in: " dwg-dir))
(progn
(setq orig-doc (vla-get-ActiveDocument (vlax-get-acad-object))
anzahl-ok 0
anzahl-fehler 0
fehler-liste nil
eintraege nil
)
(foreach datei dateien
(setq blockname (vl-filename-base datei)
dwg-pfad (strcat dwg-dir "/" datei)
)
(princ (strcat "\n[ATTR-COLLECT] Lese " datei " ..."))
(setq ergebnis (cac-collect-dwg dwg-pfad))
(if (equal (car ergebnis) 'fehler)
(progn
(princ (strcat "\n[ATTR-COLLECT] FEHLER bei " datei ": " (cdr ergebnis)))
(setq anzahl-fehler (1+ anzahl-fehler))
(setq fehler-liste (cons datei fehler-liste))
)
(progn
(setq eintraege (cons (cons blockname (cdr ergebnis)) eintraege))
(setq anzahl-ok (1+ anzahl-ok))
)
)
)
(vlax-put-property (vlax-get-acad-object) 'ActiveDocument orig-doc)
(setq eintraege (reverse eintraege))
;; JSON schreiben
(setq fh (open json-pfad "w"))
(if (null fh)
(princ (strcat "\n[ATTR-COLLECT] FEHLER: Datei kann nicht geschrieben werden: " json-pfad))
(progn
(write-line "{" fh)
(setq erste T)
(foreach paar eintraege
(if (not erste) (write-line "," fh))
(write-line (strcat " \"" (cac-json-escape (car paar)) "\": "
(cac-attribs-to-json (cdr paar) " "))
fh)
(setq erste nil)
)
(write-line "}" fh)
(close fh)
(princ (strcat "\n[ATTR-COLLECT] " json-pfad " geschrieben ("
(itoa anzahl-ok) " Bloecke)."))
)
)
(princ (strcat "\n[ATTR-COLLECT] " dwg-dir " fertig: "
(itoa anzahl-ok) " gelesen, "
(itoa anzahl-fehler) " Fehler."))
(if fehler-liste
(progn
(princ "\n[ATTR-COLLECT] WARNUNG: Fehler bei:")
(foreach datei (reverse fehler-liste)
(princ (strcat "\n - " datei))
)
)
)
)
)
)
)
(princ)
)
;; ------------------------------------------------------------
;; Hauptbefehl - verarbeitet DXFM_DATA/ils/2D und DXFM_DATA/ils/3D
;; ------------------------------------------------------------
(defun c:ILS_ATTR_COLLECT ( / data-dir basis-dir subverz dwg-dir json-pfad)
(setq data-dir (getenv "DXFM_DATA"))
(if (not data-dir)
(progn
(alert "DXFM_DATA ist nicht gesetzt.\nBitte zuerst bin/setenv.bat ausfuehren.")
(exit)
)
)
(setq data-dir (vl-string-translate "\\" "/" data-dir)
basis-dir (strcat data-dir "/ils")
)
(foreach subverz '("2D" "3D")
(setq dwg-dir (strcat basis-dir "/" subverz)
json-pfad (strcat dwg-dir "/allocations_collected.json")
)
(princ (strcat "\n[ATTR-COLLECT] === " subverz " ==="))
(cac-collect-directory dwg-dir json-pfad)
)
(princ)
)
(princ "\ncollect_attributes.lsp geladen. Befehl: ILS_ATTR_COLLECT")
(princ)
Lisp/export.lsp
+38 -16
View File
@@ -19,7 +19,7 @@
(setq cfg-pfad (strcat (getenv "DXFM_CFG") "/export.cfg"))
(setq *export-cfg* (ssg-load-ini cfg-pfad))
(if (null *export-cfg*)
(princ (strcat "\n[export] WARNUNG: " cfg-pfad " nicht gefunden/leer, verwende Vorgaben."))
(princ (ssg-textf "exp-cfg-not-found" (list cfg-pfad)))
)
(princ)
)
@@ -41,6 +41,14 @@
;; Beim Laden des Moduls einmalig einlesen (Lazy-Loading via ssg-ensure "export")
(export:load-cfg)
;; --- Test-Override fuer den Ausgabeordner (nur Lisp-Sitzungsspeicher) ---
;; Wird ausschliesslich von TEST_EXPORT_ALL (tests/test_export_all.lsp)
;; waehrend des Testlaufs auf DXFM_TESTOUT gesetzt und danach garantiert
;; wieder auf nil zurueckgesetzt. Bewusst KEIN (setenv "DXFM_RESULTS" ...):
;; (setenv ...) schreibt in BricsCAD dauerhaft in die Profil-Registry und
;; ueberlebt damit jeden Neustart.
(setq *export-test-override* nil)
;; --- Feste Datei-/Skriptnamen dieses Moduls (keine Config, direkt im Code) ---
(setq *export-filenames*
@@ -196,32 +204,46 @@
;; py-name = Python-Skript-Name (z.B. "export_csv.py")
;; csv-name = Ergebnis-CSV-Name (z.B. "export.csv")
(defun csv:run-export (label py-name csv-name / ss i ename fh out-pfad
py-skript ergebnis-pfad cmd first-block count)
py-skript ergebnis-pfad cmd first-block count out-dir)
;; Vor dem Export: IDs aller Bloecke sicherstellen und Duplikate korrigieren
(princ (strcat "\n[" label "] Pruefe und vergebe IDs..."))
(princ (ssg-textf "exp-check-ids" (list label)))
(ssg-id-check-all)
;; Vor dem Export HOEHE/DREHUNG aller Omniflo-Elemente aktualisieren
(princ (strcat "\n[" label "] Aktualisiere Hoehe/Drehung..."))
(princ (ssg-textf "exp-update-hoehe-drehung" (list label)))
(omni:update-all-attribs)
(princ (strcat "\n[" label "] Sammle relevante Bloecke..."))
(princ (ssg-textf "exp-collect-blocks" (list label)))
(setq ss (csv:collect-export-blocks))
(if (null ss)
(progn
(princ (strcat "\n[" label "] Keine relevanten Bloecke gefunden."))
(princ (ssg-textf "exp-no-blocks-found" (list label)))
(princ)
)
(progn
(setq count (sslength ss))
(princ (strcat "\n[" label "] " (itoa count) " Bloecke gefunden."))
(princ (ssg-textf "exp-blocks-found" (list label count)))
;; Ausgabeordner: DXFM_RESULTS, ausser *export-test-override* ist gesetzt
;; (nur waehrend TEST_EXPORT_ALL, siehe tests/test_export_all.lsp).
;; WICHTIG: Hier bewusst KEIN (setenv "DXFM_RESULTS" ...) verwenden!
;; (setenv ...) schreibt in BricsCAD dauerhaft in die Profil-Registry
;; und ueberlebt damit jeden Neustart - ein einziger Testlauf wuerde
;; DXFM_RESULTS fuer alle zukuenftigen Sitzungen unwiderruflich auf den
;; Testordner umbiegen. *export-test-override* ist eine reine
;; Lisp-Variable (nur Prozess-/Sitzungsspeicher) und daher sicher.
(setq out-dir (if *export-test-override*
*export-test-override*
(getenv "DXFM_RESULTS")))
(if (not (vl-file-directory-p out-dir)) (vl-mkdir out-dir))
(princ (ssg-textf "exp-output-dir" (list label out-dir)))
;; JSON-Datei zusammenbauen
(setq out-pfad (strcat (getenv "DXFM_RESULTS") "/"
(setq out-pfad (strcat out-dir "/"
(export:filename "raw_json_datei")))
(setq fh (open out-pfad "w"))
(if (null fh)
(progn
(princ (strcat "\n[" label "] FEHLER: Kann Datei nicht oeffnen: " out-pfad))
(princ (ssg-textf "exp-file-open-error" (list label out-pfad)))
(princ)
)
(progn
@@ -238,22 +260,22 @@
)
(write-line "]" fh)
(close fh)
(princ (strcat "\n[" label "] JSON geschrieben: " out-pfad))
(princ (ssg-textf "exp-json-written" (list label out-pfad)))
;; Python-Skript aufrufen
(setq py-skript (strcat (getenv "DXFM_LIB") "/" py-name))
(if (findfile py-skript)
(progn
(setq ergebnis-pfad (strcat (getenv "DXFM_RESULTS") "/" csv-name))
(setq ergebnis-pfad (strcat out-dir "/" csv-name))
(setq cmd (strcat "python \"" py-skript "\""
" \"" out-pfad "\""
" \"" (getenv "DXFM_DATA") "\""
" \"" ergebnis-pfad "\""))
(princ (strcat "\n[" label "] Rufe Python auf..."))
(princ (ssg-textf "exp-calling-python" (list label)))
(startapp "cmd" (strcat "/c " cmd))
(princ (strcat "\n[" label "] Export gestartet: " ergebnis-pfad))
(princ (ssg-textf "exp-export-started" (list label ergebnis-pfad)))
)
(princ (strcat "\n[" label "] FEHLER: Python-Skript nicht gefunden: " py-skript))
(princ (ssg-textf "exp-python-not-found" (list label py-skript)))
)
)
)
@@ -377,7 +399,7 @@
(defun c:OMNI_UPDATE_ATTRIBS ( / ss i ename ed bname teileart count)
(setq ss (ssget "X" (list (cons 0 "INSERT"))))
(if (null ss)
(princ "\n[OMNI_UPDATE] Keine INSERT-Bloecke in der Zeichnung.")
(princ (ssg-text "exp-omni-no-inserts"))
(progn
(setq count 0)
(setq i 0)
@@ -396,7 +418,7 @@
)
(setq i (1+ i))
)
(princ (strcat "\n[OMNI_UPDATE] " (itoa count) " Elemente aktualisiert (HOEHE, DREHUNG)."))
(princ (ssg-textf "exp-omni-updated" (list count)))
)
)
(princ)
Lisp/external_call.lsp
+3 -3
View File
@@ -17,12 +17,12 @@
(setq fh (open return-datei "r"))
(setq zeile (read-line fh))
(close fh)
(princ (strcat "\n[SSG_LIB] Python Rueckgabe: " zeile))
(princ (ssg-textf "extcall-python-rueckgabe" (list zeile)))
)
(princ "\n[SSG_LIB] WARNUNG: Keine Rueckgabe von Python erhalten.")
(princ (ssg-text "extcall-keine-rueckgabe"))
)
)
(princ (strcat "\n[SSG_LIB] FEHLER: " py-skript " nicht gefunden!"))
(princ (ssg-textf "extcall-skript-nicht-gefunden" (list py-skript)))
)
(princ)
)
Lisp/ssg_core.lsp
+28 -12
View File
@@ -35,7 +35,7 @@
(setvar "CMDECHO" 0)
(command "_undo" "_G")
(graphscr)
(if titel (prompt (strcat "\n***** " titel " *****\n")))
(if titel (prompt (ssg-textf "core-start-titel" (list titel))))
(princ)
)
@@ -65,7 +65,7 @@
(defun ssg-errhan (em)
(if (= em "Function cancelled")
(princ)
(progn (princ "\nFehler: ") (princ em))
(progn (princ (ssg-text "core-errhan-fehler")) (princ em))
)
(command)
(command)
@@ -85,11 +85,11 @@
(if defa
(progn
(initget 1 "Yes No Yes")
(= (getkword (strcat "\n" prompt-text " Y/N <Y>: ")) "No")
(= (getkword (strcat "\n" prompt-text (ssg-text "ques-yn-default-yes"))) "No")
)
(progn
(initget 1 "Yes No No")
(= (getkword (strcat "\n" prompt-text " Y/N <N>: ")) "Yes")
(= (getkword (strcat "\n" prompt-text (ssg-text "ques-yn-default-no"))) "Yes")
)
)
)
@@ -126,12 +126,17 @@
)
)
;; Layer anlegen (falls nicht vorhanden) und optional setzen
;; Layer anlegen (falls nicht vorhanden) und optional aktivieren
;; lay-name = Name; color = Farbnummer als String z.B. "2"; set-aktiv = T/nil
(defun ssg-make-layer (lay-name color set-aktiv)
;; Farbe wird nur bei Neuanlage gesetzt, bestehende Layer bleiben unveraendert
(defun ssg-make-layer (lay-name color set-aktiv / neu)
(setq neu (not (tblsearch "LAYER" lay-name)))
(if set-aktiv
(command "_LAYER" "_M" lay-name "_CO" color lay-name "")
(command "_LAYER" "_N" lay-name "_CO" color lay-name "")
(command "_LAYER" "_M" lay-name "")
(command "_LAYER" "_N" lay-name "")
)
(if neu
(command "_LAYER" "_CO" color lay-name "")
)
)
@@ -225,7 +230,7 @@
(command "_insert" bname pt "" "" rotation)
)
(progn
(alert (strcat "Blockname '" bname "' existiert bereits - wird uebersprungen."))
(alert (ssg-textf "core-blockname-exists" (list bname)))
(setq bname (strcat "x" bname))
(command "_block" bname pt ss "")
(command "_insert" bname pt "" "" rotation)
@@ -460,7 +465,7 @@
(defun ssg-attrib-read-dwg (dwg-pfad / tmpEnt srcAttribs oldAttreq oldAttdia)
(if (not (findfile dwg-pfad))
(progn
(princ (strcat "\nFEHLER: Block nicht gefunden: " dwg-pfad))
(princ (ssg-textf "core-dwg-not-found" (list dwg-pfad)))
nil
)
(progn
@@ -536,8 +541,8 @@
(if (not (new_dialog dialog-name dat))
(progn (alert "Dialog konnte nicht geladen werden.") (exit))
)
(if init-fn (init-fn))
(action_tile "accept" "(if accept-fn (accept-fn)) (done_dialog 1)")
(if init-fn (apply init-fn nil))
(action_tile "accept" "(if accept-fn (apply accept-fn nil)) (done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(start_dialog)
(unload_dialog dat)
@@ -733,6 +738,17 @@
((and (not in-section) (= trimmed "{")) nil)
((and (not in-section) (= trimmed "}")) nil)
;; Leere Section auf einer Zeile: "name": {}
;; (Section-Start und -Ende zugleich - json.dump schreibt leere
;; Objekte immer inline, unabhaengig von der Einrueckung.)
((and (not in-inner)
(>= (strlen trimmed) 2)
(= (substr trimmed (1- (strlen trimmed)) 2) "{}"))
(setq section (substr trimmed 2
(1- (vl-string-search "\"" trimmed 1))))
(setq ergebnis (cons (cons section nil) ergebnis))
)
;; Section-Start: "name": {
((and (not in-inner) (vl-string-search ": {" trimmed))
(setq kv (ssg-cfg-parse-kv
Lisp/ssg_dialog.lsp
+2 -2
View File
@@ -67,7 +67,7 @@
aktuell start-val
)
(if (not (new_dialog dialog-id dat))
(progn (alert "Dialog nicht verfuegbar.") (exit))
(progn (alert (ssg-text "dialog-nicht-verfuegbar")) (exit))
)
(set_tile select-tile start-val)
(if (and preview-tile slide-lib slide-list)
@@ -116,7 +116,7 @@
;; ------------------------------------------------------------
(defun ssg-insert-modul (lay-name lay-color blk-pfad attrib-alist rotation / pt)
(ssg-make-layer lay-name lay-color T)
(setq pt (getpoint "\nEinfuegepunkt waehlen: "))
(setq pt (getpoint (ssg-text "dialog-einfuegepunkt-waehlen")))
(command "_insert" blk-pfad pt "" "" rotation)
(if attrib-alist
(ssg-attrib-set-many attrib-alist)
Lisp/ssg_id.lsp
+12 -12
View File
@@ -93,11 +93,11 @@
(setq new-id (1+ max-id))
(setq new-id-str (ssg-id-format new-id))
(ssg-attrib-set-on ent (list (cons "ID" new-id-str)))
(princ (strcat "\n[ID] Neue ID zugewiesen: " new-id-str))
(princ (ssg-textf "id-new-assigned" (list new-id-str)))
new-id-str
)
(progn
(princ "\n[ID] FEHLER: Kein gueltiger INSERT-Block!")
(princ (ssg-text "id-invalid-block"))
nil
)
)
@@ -113,7 +113,7 @@
(setq ss (ssg-id-collect-blocks))
(if (null ss)
(progn
(princ "\n[IDSCHECK] Keine relevanten Bloecke gefunden.")
(princ (ssg-text "id-check-no-blocks"))
0
)
(progn
@@ -141,8 +141,8 @@
(setq max-id (1+ max-id))
(setq new-id-str (ssg-id-format max-id))
(ssg-attrib-set-on ename (list (cons "ID" new-id-str)))
(princ (strcat "\n[IDSCHECK] Fehlende ID gesetzt: " new-id-str
" (Block " (cdr (assoc 2 (entget ename))) ")"))
(princ (ssg-textf "id-check-missing-set"
(list new-id-str (cdr (assoc 2 (entget ename))))))
)
)
(setq i (1+ i))
@@ -158,16 +158,16 @@
(setq max-id (1+ max-id))
(setq new-id-str (ssg-id-format max-id))
(ssg-attrib-set-on ename (list (cons "ID" new-id-str)))
(princ (strcat "\n[IDSCHECK] Duplikat ID " (ssg-id-format (car entry))
" -> neue ID " new-id-str
" (Block " (cdr (assoc 2 (entget ename))) ")"))
(princ (ssg-textf "id-check-duplicate"
(list (ssg-id-format (car entry)) new-id-str
(cdr (assoc 2 (entget ename))))))
(setq fixed-count (1+ fixed-count))
)
)
)
)
(princ (strcat "\n[IDSCHECK] Fertig. " (itoa fixed-count) " Duplikate korrigiert."))
(princ (ssg-textf "id-check-done" (list fixed-count)))
fixed-count
)
)
@@ -179,7 +179,7 @@
(defun c:IDSCHECK ( / count)
(ssg-start "IDSCHECK" nil)
(setq count (ssg-id-check-all))
(princ (strcat "\n[IDSCHECK] " (itoa count) " IDs korrigiert."))
(princ (ssg-textf "id-check-corrected" (list count)))
(ssg-end)
(princ)
)
@@ -188,10 +188,10 @@
;; Fordert den Benutzer auf, einen Block zu waehlen und weist eine neue ID zu.
(defun c:IDGENERATE ( / ent ed)
(ssg-start "IDGENERATE" nil)
(setq ent (car (entsel "\nBlock waehlen: ")))
(setq ent (car (entsel (ssg-text "id-select-block-prompt"))))
(if (and ent (= (cdr (assoc 0 (entget ent))) "INSERT"))
(ssg-id-generate ent)
(princ "\n[IDGENERATE] Kein gueltiger Block gewaehlt.")
(princ (ssg-text "id-generate-invalid"))
)
(ssg-end)
(princ)
Lisp/ssg_lang.lsp
+148
View File
@@ -0,0 +1,148 @@
;; ============================================================
;; SSG_LANG.LSP - Sprachumschaltung (Deutsch/Englisch)
;; Zentrale Textverwaltung fuer benutzersichtbare Meldungen.
;; Kern-Modul, wird direkt nach ssg_core geladen.
;;
;; Die Texte liegen extern in lang/de_DE.json und lang/en_GB.json.
;; Diese Datei ist reiner Lade-/Zugriffscode. Beim Laden wird
;; *ssg-texts* aus den JSON-Dateien befuellt - Format wie bisher:
;; (key (cons "de_DE" wert) (cons "en_GB" wert))
;; Die JSON-Dateien werden aus Lisp/ssg_lang.lsp einmalig per
;; tools/migrate_lang_to_json.py erzeugt und danach direkt gepflegt.
;; ============================================================
;; ------------------------------------------------------------
;; Alle Vorkommen von alt in str durch neu ersetzen.
;; Frueh definiert, da ssg-lang-unescape es beim Laden braucht.
;; ------------------------------------------------------------
(defun ssg-str-replace-all (neu alt str / pos ergebnis)
(setq ergebnis "")
(while (setq pos (vl-string-search alt str))
(setq ergebnis (strcat ergebnis (substr str 1 pos) neu))
(setq str (substr str (+ pos 1 (strlen alt))))
)
(strcat ergebnis str)
)
;; ------------------------------------------------------------
;; Sprachordner ermitteln: 1) DXFMAKRO env, 2) *ssg-lisp-pfad*, 3) nil.
;; Gleiches Fallback-Muster wie in Gefaellestrecke.lsp/KreiselInsert.lsp.
;; DXFM_LANG bleibt der Sprachcode und wird hier NICHT als Pfad genutzt.
;; ------------------------------------------------------------
(defun ssg-lang-dir ( / )
(cond
((and (getenv "DXFMAKRO") (= (type (getenv "DXFMAKRO")) 'STR)
(> (strlen (getenv "DXFMAKRO")) 0))
(strcat (vl-string-right-trim "/" (vl-string-translate "\\" "/" (getenv "DXFMAKRO")))
"/lang"))
((and (boundp '*ssg-lisp-pfad*) (= (type *ssg-lisp-pfad*) 'STR)
(vl-string-search "/Lisp" *ssg-lisp-pfad*))
(strcat (substr *ssg-lisp-pfad* 1 (vl-string-search "/Lisp" *ssg-lisp-pfad*))
"/lang"))
(t nil)
)
)
;; ------------------------------------------------------------
;; Escapes aus einem JSON-Rohwert aufloesen: \n -> Zeilenumbruch.
;; Der JSON-Parser (ssg-cfg-parse-nested) liefert \n als literale
;; 2-Zeichen-Folge (Backslash + n) zurueck; hier wird sie in einen
;; echten Zeilenumbruch gewandelt. Suchmuster ist "\\n" (= die zwei
;; Zeichen Backslash+n); "\n" waere bereits ein Zeilenumbruch.
;; Andere Escapes kommen in den Sprachdateien nicht vor.
;; ------------------------------------------------------------
(defun ssg-lang-unescape (wert)
(if wert
(ssg-str-replace-all (chr 10) "\\n" wert)
)
)
;; ------------------------------------------------------------
;; Beide Sprachdateien laden und *ssg-texts* im bisherigen Format
;; befuellen: (key (cons "de_DE" ...) (cons "en_GB" ...)).
;; Fehlt eine Datei oder ein Key, bleibt der jeweilige Wert nil -
;; die Fallback-Kette in ssg-text greift dann automatisch
;; (en_GB -> de_DE -> Key). BricsCAD startet in jedem Fall.
;; ------------------------------------------------------------
(defun ssg-lang-load ( / dir de-datei en-datei de-sec en-sec
key wert-de wert-en ergebnis)
(setq *ssg-texts* nil)
(setq dir (ssg-lang-dir))
(if (null dir)
(princ "\n[LANG] WARNUNG: Sprachordner nicht ermittelbar (DXFMAKRO nicht gesetzt).")
(progn
(setq de-datei (strcat dir "/de_DE.json")
en-datei (strcat dir "/en_GB.json"))
(if (findfile de-datei)
(setq de-sec (cdr (assoc "texts"
(ssg-cfg-parse-nested (ssg-read-file-lines de-datei)))))
(princ (strcat "\n[LANG] WARNUNG: " de-datei " nicht gefunden."))
)
(if (findfile en-datei)
(setq en-sec (cdr (assoc "texts"
(ssg-cfg-parse-nested (ssg-read-file-lines en-datei)))))
(princ (strcat "\n[LANG] WARNUNG: " en-datei " nicht gefunden."))
)
(foreach paar de-sec
(setq key (car paar)
wert-de (ssg-lang-unescape (cdr paar))
wert-en (ssg-lang-unescape (cdr (assoc key en-sec))))
(setq ergebnis
(cons (list key (cons "de_DE" wert-de) (cons "en_GB" wert-en)) ergebnis))
)
(setq *ssg-texts* (reverse ergebnis))
(princ (strcat "\n[LANG] " (itoa (length *ssg-texts*)) " Texte geladen."))
)
)
(princ)
)
;; ------------------------------------------------------------
;; AKTUELLE SPRACHE
;; Default de_DE, Init aus DXFM_LANG. Ein erneutes Laden dieses
;; Moduls ueberschreibt eine zur Laufzeit gesetzte Sprache nicht.
;; ------------------------------------------------------------
(if (null *ssg-lang*)
(setq *ssg-lang* (getenv "DXFM_LANG"))
)
(if (or (null *ssg-lang*) (= *ssg-lang* ""))
(setq *ssg-lang* "de_DE")
)
;; Texttabelle aus den JSON-Sprachdateien befuellen
(ssg-lang-load)
;; ------------------------------------------------------------
;; ssg-text - Text zu einem Key in der aktuellen Sprache liefern
;; Fallback-Kette: *ssg-lang* -> de_DE -> Key selbst
;; ------------------------------------------------------------
(defun ssg-text (key / eintrag wert)
(setq eintrag (assoc key *ssg-texts*))
(if eintrag
(progn
(setq wert (cdr (assoc *ssg-lang* (cdr eintrag))))
(if (null wert)
(setq wert (cdr (assoc "de_DE" (cdr eintrag))))
)
(if (null wert) key wert)
)
key
)
)
;; ssg-textf - Text mit Platzhaltern %1 %2 ... aus einer Werteliste fuellen
(defun ssg-textf (key werte / txt i platzhalter)
(setq txt (ssg-text key))
(setq i 1)
(foreach w werte
(setq platzhalter (strcat "%" (itoa i)))
(setq txt (ssg-str-replace-all (vl-princ-to-string w) platzhalter txt))
(setq i (1+ i))
)
txt
)
(princ)
Lisp/ssg_layer.lsp
+33 -33
View File
@@ -75,12 +75,12 @@
;; Rueckgabe: neuer Layername oder nil bei Abbruch
(defun c:SSG-LayerSet (/ sel lay)
(ssg-start "Layer setzen" nil)
(if (setq lay (ssg-get-layer "\nObjekt auf dem Ziel-Layer waehlen: "))
(if (setq lay (ssg-get-layer (ssg-text "layer-prompt-ziel-layer")))
(progn
(command "_LAYER" "_SET" lay "")
(prompt (strcat "\nAktiver Layer: " lay))
(prompt (ssg-textf "layer-aktiver-layer" (list lay)))
)
(ssg-emsg "Kein Objekt gewaehlt.")
(ssg-emsg (ssg-text "layer-err-kein-objekt"))
)
(ssg-end)
lay
@@ -89,9 +89,9 @@
;; Layer eines Objektes anzeigen
(defun c:SSG-LayerInfo (/ sel lay)
(ssg-start "Layer-Info" nil)
(if (setq lay (ssg-get-layer "\nObjekt waehlen: "))
(prompt (strcat "\nObjekt liegt auf Layer: " lay))
(ssg-emsg "Kein Objekt gewaehlt.")
(if (setq lay (ssg-get-layer (ssg-text "layer-prompt-objekt")))
(prompt (ssg-textf "layer-objekt-auf-layer" (list lay)))
(ssg-emsg (ssg-text "layer-err-kein-objekt"))
)
(ssg-end)
lay
@@ -101,11 +101,11 @@
(defun c:SSG-LayerMove (/ elem ziel-lay)
(ssg-start "Layer wechseln" nil)
(if (setq elem (ssget))
(if (setq ziel-lay (ssg-get-layer "\nObjekt auf dem Ziel-Layer waehlen: "))
(if (setq ziel-lay (ssg-get-layer (ssg-text "layer-prompt-ziel-layer")))
(command "_CHANGE" elem "" "_PROP" "_LA" ziel-lay "")
(ssg-emsg "Kein Ziel-Layer gewaehlt.")
(ssg-emsg (ssg-text "layer-err-kein-ziel-layer"))
)
(ssg-emsg "Kein Objekt gewaehlt.")
(ssg-emsg (ssg-text "layer-err-kein-objekt"))
)
(ssg-end)
)
@@ -114,11 +114,11 @@
(defun c:SSG-LayerCopy (/ elem ziel-lay)
(ssg-start "Layer-Kopie" nil)
(if (setq elem (ssget))
(if (setq ziel-lay (ssg-get-layer "\nObjekt auf dem Ziel-Layer waehlen: "))
(if (setq ziel-lay (ssg-get-layer (ssg-text "layer-prompt-ziel-layer")))
(command "_COPY" elem "" "@" "@" "_CHANGE" elem "" "_PROP" "_LA" ziel-lay "")
(ssg-emsg "Kein Ziel-Layer gewaehlt.")
(ssg-emsg (ssg-text "layer-err-kein-ziel-layer"))
)
(ssg-emsg "Kein Objekt gewaehlt.")
(ssg-emsg (ssg-text "layer-err-kein-objekt"))
)
(ssg-end)
)
@@ -127,34 +127,34 @@
;; (nach Auswahl eines Referenz-Objektes dieses Typs)
(defun c:SSG-LayerMoveType (/ ref-lay ref-typ elem ziel-lay ss ref-sel)
(ssg-start "Layer-Typ verschieben" nil)
(if (setq ref-lay (ssg-get-layer "\nReferenz-Objekt waehlen (bestimmt Typ und Layer): "))
(if (setq ref-lay (ssg-get-layer (ssg-text "layer-prompt-referenz-objekt")))
(progn
(setq ref-sel (entsel "\nNochmals fuer Typ-Ermittlung anklicken: "))
(setq ref-sel (entsel (ssg-text "layer-prompt-typ-ermittlung")))
(if ref-sel
(progn
(setq ref-typ (cdr (assoc 0 (entget (car ref-sel))))
ss (ssg-layer-ss ref-lay ref-typ)
)
(if ss
(if (setq ziel-lay (ssg-get-layer "\nObjekt auf dem Ziel-Layer waehlen: "))
(if (setq ziel-lay (ssg-get-layer (ssg-text "layer-prompt-ziel-layer")))
(progn
(ssg-zoom-save)
(ssg-ss-redraw ss 3)
(if (not (ssg-ques (strcat "Layer dieser " ref-typ "-Objekte wechseln?") nil))
(if (not (ssg-ques (ssg-textf "layer-ques-typ-wechseln" (list ref-typ)) nil))
(command "_CHANGE" ss "" "_PROP" "_LA" ziel-lay "")
(ssg-ss-redraw ss 4)
)
(ssg-zoom-restore)
)
(ssg-emsg "Kein Ziel-Layer.")
(ssg-emsg (ssg-text "layer-err-kein-ziel-layer-kurz"))
)
(ssg-emsg "Keine passenden Objekte gefunden.")
(ssg-emsg (ssg-text "layer-err-keine-passenden-objekte"))
)
)
(ssg-emsg "Abgebrochen.")
(ssg-emsg (ssg-text "layer-abgebrochen"))
)
)
(ssg-emsg "Kein Referenz-Objekt gewaehlt.")
(ssg-emsg (ssg-text "layer-err-kein-referenz-objekt"))
)
(ssg-end)
)
@@ -167,10 +167,10 @@
;; Layer durch Anklicken ausschalten
(defun c:SSG-LayerOff (/ lay)
(ssg-start "Layer ausschalten" nil)
(while (setq lay (ssg-get-layer "\nLayer zum Ausblenden anklicken (Enter=Ende): "))
(while (setq lay (ssg-get-layer (ssg-text "layer-prompt-ausblenden")))
(if (ssg-layer-safe-p lay nil)
(command "_LAYER" "_OFF" lay "")
(ssg-emsg "Aktiven Layer nicht ausschalten!")
(ssg-emsg (ssg-text "layer-err-aktiv-nicht-ausschalten"))
)
)
(ssg-end)
@@ -179,10 +179,10 @@
;; Layer durch Anklicken einfrieren
(defun c:SSG-LayerFreeze (/ lay)
(ssg-start "Layer einfrieren" nil)
(while (setq lay (ssg-get-layer "\nLayer zum Einfrieren anklicken (Enter=Ende): "))
(while (setq lay (ssg-get-layer (ssg-text "layer-prompt-einfrieren")))
(if (ssg-layer-safe-p lay nil)
(command "_LAYER" "_FR" lay "")
(ssg-emsg "Aktiven Layer nicht einfrieren!")
(ssg-emsg (ssg-text "layer-err-aktiv-nicht-einfrieren"))
)
)
(ssg-end)
@@ -191,13 +191,13 @@
;; Alle Layer ausser dem aktiven einfrieren
(defun c:SSG-FreezeAll (/ aktiv)
(ssg-start "Alle anderen Layer einfrieren" nil)
(setq aktiv (ssg-get-layer "\nObjekt auf dem Layer waehlen, der AKTIV bleibt: "))
(setq aktiv (ssg-get-layer (ssg-text "layer-prompt-aktiv-bleibt")))
(if aktiv
(progn
(command "_LAYER" "_SET" aktiv "_FR" "*" "")
(prompt (strcat "\nNur Layer '" aktiv "' ist sichtbar."))
(prompt (ssg-textf "layer-nur-layer-sichtbar" (list aktiv)))
)
(ssg-emsg "Abgebrochen.")
(ssg-emsg (ssg-text "layer-abgebrochen"))
)
(ssg-end)
)
@@ -278,34 +278,34 @@
(defun c:SSG-LayerDelete (/ lay ss)
(ssg-start "Layer loeschen" nil)
(initget 1)
(setq lay (getstring "\nLayername zum Loeschen: "))
(setq lay (getstring (ssg-text "layer-prompt-name-loeschen")))
(if (tblsearch "LAYER" lay)
(progn
(setq ss (ssg-layer-ss lay nil))
(if ss
(progn
(ssg-ss-redraw ss 4)
(if (not (ssg-ques (strcat "Alle Objekte auf Layer '" lay "' loeschen?") nil))
(if (not (ssg-ques (ssg-textf "layer-ques-alle-loeschen" (list lay)) nil))
(progn
(command "_ERASE" ss "")
(command "_LAYER" "_OFF" lay "")
(command "_PURGE" "_LA" lay "N")
(prompt (strcat "\nLayer '" lay "' geloescht."))
(prompt (ssg-textf "layer-geloescht" (list lay)))
)
(progn
(ssg-ss-redraw ss 0)
(prompt "\nAbgebrochen.")
(prompt (strcat "\n" (ssg-text "layer-abgebrochen")))
)
)
)
(progn
(command "_LAYER" "_OFF" lay "")
(command "_PURGE" "_LA" lay "N")
(prompt (strcat "\nLeerer Layer '" lay "' geloescht."))
(prompt (ssg-textf "layer-leerer-geloescht" (list lay)))
)
)
)
(ssg-emsg (strcat "Layer '" lay "' existiert nicht."))
(ssg-emsg (ssg-textf "layer-existiert-nicht" (list lay)))
)
(ssg-end)
)
Lisp/ssg_load.lsp
+2 -1
View File
@@ -24,6 +24,7 @@
)
(load (strcat base-path "ssg_core.lsp") "ssg_core.lsp nicht gefunden")
(ssg-load-config)
(load (strcat base-path "ssg_lang.lsp") "ssg_lang.lsp nicht gefunden")
(load (strcat base-path "ssg_dbg.lsp") "ssg_dbg.lsp nicht gefunden")
(load (strcat base-path "ssg_dialog.lsp") "ssg_dialog.lsp nicht gefunden")
(load (strcat base-path "ssg_layer.lsp") "ssg_layer.lsp nicht gefunden")
@@ -34,7 +35,7 @@
(load (strcat base-path "tests.lsp") "tests.lsp nicht gefunden")
(load (strcat base-path "OmniModulInsert.lsp") "OmniModulInsert.lsp nicht gefunden")
(load (strcat base-path "SSG_LIB_Commands.lsp") "SSG_LIB_Commands.lsp nicht gefunden")
(prompt "\nSSG-Bibliotheken geladen: ssg_core, ssg_dbg, ssg_dialog, ssg_layer, KreiselInsert, VarioFoerderer, Gefaellestrecke, export, tests, OmniModulInsert, SSG_LIB_Commands")
(prompt "\nSSG-Bibliotheken geladen: ssg_core, ssg_lang, ssg_dbg, ssg_dialog, ssg_layer, KreiselInsert, VarioFoerderer, Gefaellestrecke, export, tests, OmniModulInsert, SSG_LIB_Commands")
(princ)
)
Lisp/vf_core.lsp
+128 -143
View File
@@ -253,14 +253,14 @@
(setq block-datei (strcat block-pfad blockname ".dwg"))
(if (findfile block-datei)
(progn
(princ (strcat "\n Lade Block: " blockname " ..."))
(princ (ssg-textf "vfc-lade-block" (list blockname)))
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
block-datei 1.0 1.0 1.0 0))
(vla-Delete temp-obj)
(princ " OK")
(princ (ssg-text "vfc-status-ok"))
)
(princ (strcat "\n FEHLER: Block-Datei nicht gefunden: " block-datei))
(princ (ssg-textf "vfc-fehler-block-datei-fehlt" (list block-datei)))
)
)
)
@@ -341,7 +341,7 @@
;; ============================================================
(defun get-3d-point-from-object (msg / ent obj pt variant)
(princ msg)
(princ "\n >> Objekt (Block) waehlen: ")
(princ (ssg-text "vfc-objekt-block-waehlen"))
(setq ent (entsel))
(if ent
(progn
@@ -350,17 +350,17 @@
(progn
(setq variant (vla-get-InsertionPoint obj))
(setq pt (vlax-safearray->list (vlax-variant-value variant)))
(princ (strcat "\n Block-Einfuegepunkt: X=" (rtos (car pt) 2 3)
" Y=" (rtos (cadr pt) 2 3) " Z=" (rtos (caddr pt) 2 3)))
(princ (ssg-textf "vfc-block-einfuegepunkt"
(list (rtos (car pt) 2 3) (rtos (cadr pt) 2 3) (rtos (caddr pt) 2 3))))
)
(progn
(setq pt (cadr ent))
(princ (strcat "\n Punkt auf Objekt: Z=" (rtos (caddr pt) 2 2) " mm"))
(princ (ssg-textf "vfc-punkt-auf-objekt" (list (rtos (caddr pt) 2 2))))
)
)
)
(progn
(princ "\n Kein Objekt gewaehlt.")
(princ (ssg-text "vfc-kein-objekt-gewaehlt"))
(setq pt nil)
)
)
@@ -369,7 +369,7 @@
(defun get-line-start-end-points (msg / ent obj obj-name start-pt end-pt)
(princ msg)
(princ "\n >> 3D-Linie oder Polylinie waehlen: ")
(princ (ssg-text "vfc-linie-polylinie-waehlen"))
(setq ent (entsel))
(if ent
(progn
@@ -381,29 +381,24 @@
(vlax-variant-value (vla-get-StartPoint obj))))
(setq end-pt (vlax-safearray->list
(vlax-variant-value (vla-get-EndPoint obj))))
(princ (strcat "\n 3D-Linie:"
"\n Start: X=" (rtos (car start-pt) 2 2)
" Y=" (rtos (cadr start-pt) 2 2)
" Z=" (rtos (caddr start-pt) 2 2)
"\n Ende: X=" (rtos (car end-pt) 2 2)
" Y=" (rtos (cadr end-pt) 2 2)
" Z=" (rtos (caddr end-pt) 2 2)))
(princ (ssg-textf "vfc-3dlinie-start-ende"
(list (rtos (car start-pt) 2 2) (rtos (cadr start-pt) 2 2) (rtos (caddr start-pt) 2 2)
(rtos (car end-pt) 2 2) (rtos (cadr end-pt) 2 2) (rtos (caddr end-pt) 2 2))))
)
((= obj-name "AcDbPolyline")
(setq start-pt (vlax-curve-getStartPoint obj))
(setq end-pt (vlax-curve-getEndPoint obj))
(princ (strcat "\n 3D-Polylinie:"
"\n Start Z=" (rtos (caddr start-pt) 2 2)
" Ende Z=" (rtos (caddr end-pt) 2 2)))
(princ (ssg-textf "vfc-3dpolylinie-start-ende"
(list (rtos (caddr start-pt) 2 2) (rtos (caddr end-pt) 2 2))))
)
(t
(princ "\n FEHLER: Keine Linie oder Polylinie ausgewaehlt!")
(princ (ssg-text "vfc-fehler-keine-linie"))
(setq start-pt nil end-pt nil)
)
)
)
(progn
(princ "\n Kein Objekt gewaehlt.")
(princ (ssg-text "vfc-kein-objekt-gewaehlt"))
(setq start-pt nil end-pt nil)
)
)
@@ -443,18 +438,18 @@
rad-h chv shv ein-x ein-y ein-z dx-loc dy-loc dz-loc offset ausgang)
(if (or (null einfuegepunkt) (not (listp einfuegepunkt)))
(progn
(princ (strcat "\n FEHLER: Ungueltiger Einfuegepunkt fuer '" blockname "'"))
(princ (ssg-textf "vfc-fehler-ungueltiger-einfuegepunkt" (list blockname)))
(exit)
)
)
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
(princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek-abgebrochen" (list blockname)))
(exit)
)
)
(princ (strcat "\n Fuege Block '" blockname "' ein... (hz=" (rtos (float hz) 2 1) (chr 176) ")"))
(princ (ssg-textf "vfc-fuege-block-ein-hz" (list blockname (rtos (float hz) 2 1) (chr 176))))
(setq rad-h (* (float hz) (/ pi 180.0)))
(setq chv (cos rad-h) shv (sin rad-h))
;; KS_EIN/KS_AUS ueber eigenes Temp-Objekt am Ursprung ermitteln (nicht am
@@ -499,13 +494,12 @@
(+ (car einfuegepunkt) (- (* chv dx-loc) (* shv dy-loc)))
(+ (cadr einfuegepunkt) (+ (* shv dx-loc) (* chv dy-loc)))
(+ (caddr einfuegepunkt) dz-loc)))
(princ (strcat "\n KS_AUS: X=" (rtos (car ausgang) 2 2)
" Y=" (rtos (cadr ausgang) 2 2)
" Z=" (rtos (caddr ausgang) 2 2)))
(princ (ssg-textf "vfc-ks-aus-xyz"
(list (rtos (car ausgang) 2 2) (rtos (cadr ausgang) 2 2) (rtos (caddr ausgang) 2 2))))
ausgang
)
(progn
(princ "\n WARNUNG: KS_EIN/KS_AUS nicht gefunden!")
(princ (ssg-text "vfc-warnung-ks-nicht-gefunden"))
einfuegepunkt
)
)
@@ -523,7 +517,7 @@
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek"))
(princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek" (list blockname)))
(exit)))
;; Ziel-Rahmen auspacken
(setq P-t (car target-frame)
@@ -543,7 +537,7 @@
(setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data)))
(if (not (and ks-ein-raw ks-aus-raw))
(progn
(princ (strcat "\n FEHLER: KS_EIN/KS_AUS fehlen in '" blockname "'"))
(princ (ssg-textf "vfc-fehler-ks-fehlen" (list blockname)))
(exit)))
;; Block am Ursprung einfuegen (Rotation=0, Massstab=1) - dieses Objekt
;; bleibt tatsaechlich in der Zeichnung.
@@ -583,10 +577,8 @@
(setq xu-out (mat3-mul-vec3 R xu-aus)
yu-out (mat3-mul-vec3 R yu-aus)
zu-out (mat3-mul-vec3 R zu-aus))
(princ (strcat "\n '" blockname "' eingefuegt"
"\n KS_AUS: X=" (rtos (car P-out) 2 2)
" Y=" (rtos (cadr P-out) 2 2)
" Z=" (rtos (caddr P-out) 2 2)))
(princ (ssg-textf "vfc-block-eingefuegt-ksaus"
(list blockname (rtos (car P-out) 2 2) (rtos (cadr P-out) 2 2) (rtos (caddr P-out) 2 2))))
(list P-out xu-out yu-out zu-out))
;; Fuegt Block ein: Orientierung wie insert-block-ks-to-ks (KS_EIN-Achsen werden
@@ -613,7 +605,7 @@
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek"))
(princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek" (list blockname)))
(exit)))
;; Ziel-Rahmen auspacken
(setq P-t (car target-frame)
@@ -633,7 +625,7 @@
(setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data)))
(if (not (and ks-ein-raw ks-aus-raw))
(progn
(princ (strcat "\n FEHLER: KS_EIN/KS_AUS fehlen in '" blockname "'"))
(princ (ssg-textf "vfc-fehler-ks-fehlen" (list blockname)))
(exit)))
;; Block am Ursprung einfuegen (Rotation=0, Massstab=1) - dieses Objekt
;; bleibt tatsaechlich in der Zeichnung.
@@ -681,11 +673,11 @@
(setq xu-out (mat3-mul-vec3 R xu-aus)
yu-out (mat3-mul-vec3 R yu-aus)
zu-out (mat3-mul-vec3 R zu-aus))
(princ (strcat "\n '" blockname "' eingefuegt (XY:" (if xy-ref xy-ref "Ursprung")
" Z:" (if z-ref z-ref "Ursprung") ")"
"\n KS_AUS: X=" (rtos (car P-out) 2 2)
" Y=" (rtos (cadr P-out) 2 2)
" Z=" (rtos (caddr P-out) 2 2)))
(princ (ssg-textf "vfc-block-eingefuegt-xyzref-ksaus"
(list blockname
(if xy-ref xy-ref (ssg-text "vfc-ursprung"))
(if z-ref z-ref (ssg-text "vfc-ursprung"))
(rtos (car P-out) 2 2) (rtos (cadr P-out) 2 2) (rtos (caddr P-out) 2 2))))
(list P-out xu-out yu-out zu-out))
;; ============================================================
@@ -752,9 +744,13 @@
nil))))
;; 30/90-Wahl fuer ein AS/ES-Element. Rueckgabe: "30" oder "90" (Vorgabe 90).
(defun vf-frage-element-winkel (label)
(princ (strcat "\n\n" label " - Winkel: 1 - 90 Grad 2 - 30 Grad"))
(if (= (getstring "\nIhre Wahl (1/2) [1]: ") "2") "30" "90"))
;; headerkey: i18n-Key fuer die Kopfzeile ("vf-winkel-aus-header" oder
;; "vf-winkel-ein-header"). Rueckgabe: "30" oder "90" (Default 90).
(defun vf-frage-element-winkel (headerkey)
(princ (ssg-text headerkey))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(if (= (getstring (ssg-text "prompt-wahl-1-2")) "2") "30" "90"))
;; AS-/ES-Masse-Globals (aus-dx/dy/dz bzw. ein-dx/dy/dz) fuer die gewaehlte
;; Winkel-/Seiten-Variante neu setzen (fuer berechne-alle-winkel, GF-Winkel,
@@ -772,20 +768,19 @@
rad-v rad-h chv shv cvv svv matrix block-obj endpunkt scale)
(if (<= laenge 0.1)
(progn
(princ (strcat "\n Laenge=" (rtos laenge 2 2) " mm -> uebersprungen"))
(princ (ssg-textf "vfc-laenge-uebersprungen" (list (rtos laenge 2 2))))
startpunkt
)
(progn
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
(princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek-abgebrochen" (list blockname)))
(exit)
)
)
(princ (strcat "\n Fuege '" blockname "' ein"
" (L=" (rtos laenge 2 2) " mm, W=" (itoa winkel) (chr 176)
" hz=" (rtos (float hz) 2 1) (chr 176) ")"))
(princ (ssg-textf "vfc-fuege-ein-lwhz"
(list blockname (rtos laenge 2 2) (itoa winkel) (chr 176) (rtos (float hz) 2 1) (chr 176))))
(setq scale (/ laenge (ssg-cfg-or "vario" "skalierung_basis" 1000.0)))
(setq rad-v (* (float winkel) (/ pi 180.0)))
(setq rad-h (* (float hz) (/ pi 180.0)))
@@ -807,9 +802,8 @@
(+ (car startpunkt) (* laenge chv cvv))
(+ (cadr startpunkt) (* laenge shv cvv))
(+ (caddr startpunkt) (* laenge (- svv)))))
(princ (strcat "\n Endpunkt: X=" (rtos (car endpunkt) 2 2)
" Y=" (rtos (cadr endpunkt) 2 2)
" Z=" (rtos (caddr endpunkt) 2 2)))
(princ (ssg-textf "vfc-endpunkt-xyz"
(list (rtos (car endpunkt) 2 2) (rtos (cadr endpunkt) 2 2) (rtos (caddr endpunkt) 2 2))))
endpunkt
)
)
@@ -837,20 +831,19 @@
dx dz ins-pt endpunkt)
(if (or (null startpunkt) (not (listp startpunkt)))
(progn
(princ (strcat "\n FEHLER: Ungueltiger Einfuegepunkt fuer '" blockname "'"))
(princ (ssg-textf "vfc-fehler-ungueltiger-einfuegepunkt" (list blockname)))
startpunkt
)
(progn
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
(princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek-abgebrochen" (list blockname)))
(exit)
)
)
(princ (strcat "\n Fuege Block '" blockname "' ein"
" (Rotation " (itoa winkel) (chr 176)
" hz=" (rtos (float hz) 2 1) (chr 176) ")"))
(princ (ssg-textf "vfc-fuege-block-ein-rotation-hz"
(list blockname (itoa winkel) (chr 176) (rtos (float hz) 2 1) (chr 176))))
(setq rad-v (* winkel (/ pi 180.0)))
(setq rad-h (* (float hz) (/ pi 180.0)))
(setq chv (cos rad-h) shv (sin rad-h) cvv (cos rad-v) svv (sin rad-v))
@@ -906,10 +899,9 @@
(+ (car startpunkt) (+ (* dx chv cvv) (* dz chv svv)))
(+ (cadr startpunkt) (+ (* dx shv cvv) (* dz shv svv)))
(+ (caddr startpunkt) (+ (* dx (- svv)) (* dz cvv)))))
(princ (strcat "\n Endpunkt: X=" (rtos (car endpunkt) 2 2)
" Y=" (rtos (cadr endpunkt) 2 2)
" Z=" (rtos (caddr endpunkt) 2 2)
" (dx=" (rtos dx 2 1) " dz=" (rtos dz 2 1) ")"))
(princ (ssg-textf "vfc-endpunkt-xyz-dxdz"
(list (rtos (car endpunkt) 2 2) (rtos (cadr endpunkt) 2 2) (rtos (caddr endpunkt) 2 2)
(rtos dx 2 1) (rtos dz 2 1))))
endpunkt
)
)
@@ -920,24 +912,24 @@
;; ============================================================
(defun vf-eingabe-abfragen ( / eingabe-modus line-points startpunkt endpunkt differenz
deltaL deltaH deltaX deltaY richtung antwort hz-winkel)
(princ "\n\nEingabemodus waehlen:")
(princ "\n 1 - 3D-Linie auswaehlen (Start- und Endpunkt mit Hoehe)")
(princ "\n 2 - Werte manuell eingeben")
(setq antwort (getstring "\nIhre Wahl (1/2): "))
(princ (ssg-text "vfc-eingabemodus-header"))
(princ (ssg-text "vfc-eingabemodus-3dlinie"))
(princ (ssg-text "vfc-eingabemodus-werte"))
(setq antwort (getstring (ssg-text "vfc-prompt-wahl-1-2-ohne-default")))
(cond
((= antwort "1") (setq eingabe-modus "Linie"))
((= antwort "2") (setq eingabe-modus "Wert"))
(t (setq eingabe-modus "Linie") (princ "\nModus: 3D-Linie"))
(t (setq eingabe-modus "Linie") (princ (ssg-text "vfc-modus-3dlinie-fallback")))
)
(if (= eingabe-modus "Linie")
(progn
(princ "\n\n>>> MODUS: 3D-Linie auswaehlen <<<")
(princ (ssg-text "vfc-modus-3dlinie-header"))
(command "BKS" "W")
(princ "\n BKS auf Weltkoordinaten gesetzt.")
(princ (ssg-text "vfc-bks-weltkoordinaten"))
(setq line-points
(get-line-start-end-points "\nBitte 3D-Linie fuer die Foerderstrecke auswaehlen:"))
(get-line-start-end-points (ssg-text "vfc-bitte-3dlinie-foerderstrecke")))
(if (null line-points)
(progn (alert "Keine gueltige Linie ausgewaehlt!") (exit))
(progn (alert (ssg-text "vfc-alert-keine-gueltige-linie")) (exit))
)
(setq startpunkt (car line-points)
endpunkt (cadr line-points))
@@ -949,20 +941,19 @@
;; Fahrtrichtung aus der Linie ableiten (0=Ost, 90=Nord, ...)
(setq hz-winkel
(* (angle '(0.0 0.0) (list (car differenz) (cadr differenz))) (/ 180.0 pi)))
(princ (strcat "\n △L=" (rtos deltaL 2 2) " mm"
" △H=" (rtos deltaH 2 2) " mm"
" Fahrtrichtung=" (rtos hz-winkel 2 1) grad-zeichen))
(princ (ssg-textf "vfc-delta-l-h-richtung"
(list (chr 916) (rtos deltaL 2 2) (rtos deltaH 2 2) (rtos hz-winkel 2 1) grad-zeichen)))
(if (>= deltaH 0)
(progn (setq richtung "Auf") (princ "\n Foerderrichtung: AUF"))
(progn (setq richtung "Auf") (princ (ssg-text "vfc-foerderrichtung-auf")))
(progn (setq richtung "Ab") (setq deltaH (abs deltaH))
(princ "\n Foerderrichtung: AB"))
(princ (ssg-text "vfc-foerderrichtung-ab")))
)
)
(progn
(princ "\n\n>>> MODUS: Manuelle Werteingabe <<<")
(setq deltaL (getreal "\n△L - Horizontale Distanz (mm): "))
(princ (ssg-text "vfc-modus-werteingabe-header"))
(setq deltaL (getreal (ssg-textf "vfc-prompt-delta-l" (list (chr 916)))))
(if (null deltaL) (setq deltaL 15000))
(setq deltaH (getreal "\n△H - Hoehenunterschied (mm): "))
(setq deltaH (getreal (ssg-textf "vfc-prompt-delta-h" (list (chr 916)))))
(if (null deltaH) (setq deltaH 3000))
;; Foerderrichtung bleibt eine einfache Auf/Ab-Frage - die horizontale
;; Zwischenstrecke ist geometrisch NUR bei "Ab" ueberhaupt erreichbar
@@ -970,25 +961,25 @@
;; erst SPAETER, nach Bibliotheks-Init, als Zusatzoption in der
;; Winkel-Auswahl angeboten (siehe c:VarioFoerderer) - einheitlich fuer
;; Werteingabe UND 3D-Linie.
(princ "\nFoerderrichtung:\n 1 - AUF\n 2 - AB")
(setq antwort (getstring "\nIhre Wahl (1/2): "))
(princ (ssg-text "vfc-foerderrichtung-menu"))
(setq antwort (getstring (ssg-text "vfc-prompt-wahl-1-2-ohne-default")))
(if (= antwort "2") (setq richtung "Ab") (setq richtung "Auf"))
(setq startpunkt (getpoint "\nStartpunkt fuer AUS_Element waehlen: "))
(setq startpunkt (getpoint (ssg-text "vfc-prompt-startpunkt-aus")))
(if (null startpunkt) (setq startpunkt '(0 0 0)))
;; Horizontale Fahrtrichtung waehlen (analog Gefaellestrecke Modus 1)
(princ "\n\nFahrtrichtung waehlen:")
(princ "\n 1 - 0° (X-Achse +, Ost)")
(princ "\n 2 - 90° (Y-Achse +, Nord)")
(princ "\n 3 - 180° (X-Achse -, West)")
(princ "\n 4 - 270° (Y-Achse -, Sued)")
(setq antwort (getstring "\nIhre Wahl (1/2/3/4) [1]: "))
(princ (ssg-text "vfc-fahrtrichtung-header"))
(princ (ssg-textf "vfc-fahrtrichtung-0" (list grad-zeichen)))
(princ (ssg-textf "vfc-fahrtrichtung-90" (list grad-zeichen)))
(princ (ssg-textf "vfc-fahrtrichtung-180" (list grad-zeichen)))
(princ (ssg-textf "vfc-fahrtrichtung-270" (list grad-zeichen)))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2-3-4")))
(cond
((= antwort "2") (setq hz-winkel 90.0))
((= antwort "3") (setq hz-winkel 180.0))
((= antwort "4") (setq hz-winkel 270.0))
(t (setq hz-winkel 0.0))
)
(princ (strcat "\n>>> Fahrtrichtung: " (rtos hz-winkel 2 1) grad-zeichen))
(princ (ssg-textf "vfc-fahrtrichtung-ergebnis" (list (rtos hz-winkel 2 1) grad-zeichen)))
)
)
(list deltaL deltaH richtung startpunkt hz-winkel eingabe-modus)
@@ -1016,7 +1007,7 @@
(setq L_GF_str (strcat (rtos (/ L_GF1 1000.0) 2 3) "," (rtos (/ L_GF2 1000.0) 2 3)))
(setq label-txt
(strcat "VF" (itoa vf-nummer)
": von " (itoa (fix hoehe-von)) "mm bis " (itoa (fix hoehe-bis)) "mm, "
(ssg-textf "vfc-label-von-bis" (list (itoa (fix hoehe-von)) (itoa (fix hoehe-bis))))
delta-sym "H=" (itoa (fix deltaH)) "mm; "
delta-sym "L=" (itoa (fix deltaL)) "mm; "
"VF:" L_VF_str "m; GF:" L_GF_str "m; "
@@ -1159,9 +1150,9 @@
;; Aufsteigende, eindeutige ID vergeben (wie beim Kreisel), falls verfuegbar.
(if (car (atoms-family 1 '("SSG-ID-GENERATE")))
(ssg-id-generate vf-insert))
(princ (strcat "\n>>> Block '" vf-bname "' erstellt und eingefuegt."))
(princ (ssg-textf "vfc-block-erstellt-eingefuegt" (list vf-bname)))
)
(princ "\n>>> FEHLER: Keine Entities fuer Block gefunden!")
(princ (ssg-text "vfc-fehler-keine-entities"))
)
)
@@ -1207,13 +1198,13 @@
staustrecke-basis)
(princ "\n=========================================")
(princ "\n VARIOFOERDERER GENERATOR v26.0")
(princ (ssg-text "vfc-banner-titel"))
(princ "\n=========================================")
;; 1. Typ aus Registry waehlen
(if (null *vf-typ-registry*)
(progn
(alert "Keine Typen registriert!\nvf_standard.lsp und vf_etage.lsp pruefen.")
(alert (ssg-text "vfc-alert-keine-typen"))
(exit)
)
)
@@ -1221,19 +1212,19 @@
(if (and *vf-vorauswahl-typ* (assoc *vf-vorauswahl-typ* *vf-typ-registry*))
(progn
(setq typ-eintr (assoc *vf-vorauswahl-typ* *vf-typ-registry*))
(princ (strcat "\n>>> Typ vorgewaehlt: " *vf-vorauswahl-typ*))
(princ (ssg-textf "vfc-typ-vorgewaehlt" (list *vf-vorauswahl-typ*)))
(setq *vf-vorauswahl-typ* nil)
)
(progn
(setq *vf-vorauswahl-typ* nil)
(princ "\n\nAnlagen-Typ waehlen:")
(princ (ssg-text "vfc-anlagen-typ-header"))
(setq idx 1)
(foreach eintr *vf-typ-registry*
(princ (strcat "\n " (itoa idx) " - " (nth 3 eintr)))
(princ (ssg-textf "vfc-typ-option" (list idx (nth 3 eintr))))
(setq idx (1+ idx))
)
(setq wahl (getint (strcat "\nIhre Wahl (1-"
(itoa (length *vf-typ-registry*)) ") [1]: ")))
(setq wahl (getint (ssg-textf "vfc-prompt-wahl-1-n"
(list (length *vf-typ-registry*)))))
(if (or (null wahl) (< wahl 1) (> wahl (length *vf-typ-registry*)))
(setq wahl 1))
(setq typ-eintr (nth (1- wahl) *vf-typ-registry*))
@@ -1242,7 +1233,7 @@
(setq anlage-typ (nth 0 typ-eintr))
(setq berechne-fn (nth 1 typ-eintr))
(setq einfuege-fn (nth 2 typ-eintr))
(princ (strcat "\n>>> Typ: " anlage-typ))
(princ (ssg-textf "vfc-typ-gewaehlt" (list anlage-typ)))
;; Sonderfall "linienzug": eigener Befehlsablauf (interaktive Mehrsegment-
;; Kette mit gemischten GF/VF-Segmenten), passt nicht in das berechne-fn/
@@ -1267,7 +1258,7 @@
;; 2. VF-Nummer automatisch ermitteln
(setq vf-nummer (vf-next-number))
(princ (strcat "\n>>> Naechste VF-Nummer: VF" (itoa vf-nummer)))
(princ (ssg-textf "vfc-naechste-vf-nummer" (list (itoa vf-nummer))))
;; 3. Gemeinsame Eingabe (deltaL, deltaH, richtung, startpunkt) - richtung
;; steht bei beiden Eingabemodi (Werteingabe UND 3D-Linie) bereits fest.
@@ -1280,12 +1271,12 @@
eingabe-modus (nth 5 eingabe))
;; 4. Seite-Auswahl (vor Berechnung, weil Etage-Typ sie fuer Geometrie braucht)
(princ "\n\nSeite waehlen:")
(princ "\n 1 - Rechts")
(princ "\n 2 - Links")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(princ (ssg-text "vfc-seite-header"))
(princ (ssg-text "vfc-seite-rechts"))
(princ (ssg-text "vfc-seite-links"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(if (= antwort "2") (setq seite "links") (setq seite "rechts"))
(princ (strcat "\n>>> Seite: " seite))
(princ (ssg-textf "vfc-seite-gewaehlt" (list seite)))
;; 5. Typ-spezifische Berechnung (init + Winkelsuche)
(setq ergebnis (apply berechne-fn (list deltaL deltaH richtung seite)))
@@ -1304,7 +1295,7 @@
(setq ergebnis-liste
(append ergebnis-liste
(list (list 0 (car horizontal-info) (cadr horizontal-info) T))))
(princ "\n\n>>> Hinweis: Ein horizontale Variofoerderer ( 0°) ist bei diesem △L/△H zusaetzlich moeglich!")
(princ (ssg-textf "vfc-hinweis-horizontal-moeglich" (list (chr 176) (chr 916))))
)
(setq horizontal-info nil)
)
@@ -1324,9 +1315,8 @@
ergebnis-liste)))
(if (null gueltige-winkel)
(progn
(alert (strcat "Kein passender Winkel gefunden!\n"
"△L=" (rtos deltaL 2 0) " mm, △H="
(rtos deltaH 2 0) " mm, Richtung=" richtung))
(alert (ssg-textf "vfc-alert-kein-winkel"
(list (chr 916) (rtos deltaL 2 0) (rtos deltaH 2 0) richtung)))
(exit)
)
)
@@ -1340,29 +1330,27 @@
(setq eintrag (assoc best-winkel ergebnis-liste))
(setq L_GF (nth 1 eintrag) L_VF (nth 2 eintrag))
(if (= best-winkel 0)
(princ "\n\n>>> Einzige gueltige Variante: Horizontale Variofoerderer")
(princ (strcat "\n\n>>> Einziger gueltiger Winkel: "
(itoa best-winkel) (chr 176)))
(princ (ssg-text "vfc-einzige-variante-horizontal"))
(princ (ssg-textf "vfc-einziger-winkel" (list (itoa best-winkel) (chr 176))))
)
)
(progn
(princ "\n\nMehrere gueltige Winkel verfuegbar. Bitte waehlen:")
(princ (ssg-text "vfc-mehrere-winkel-header"))
(setq idx 1)
(foreach w gueltige-winkel
(setq eintrag (assoc w ergebnis-liste))
(if (= w 0)
(princ (strcat "\n " (itoa idx) " - Horizontale Variofoerderer (0"
(chr 176) ")"
" (L_GF=" (rtos (nth 1 eintrag) 2 1)
" mm, L_VF=" (rtos (nth 2 eintrag) 2 1) " mm)"))
(princ (strcat "\n " (itoa idx) " - " (itoa w) (chr 176)
" (L_GF=" (rtos (nth 1 eintrag) 2 1)
" mm, L_VF=" (rtos (nth 2 eintrag) 2 1) " mm)"))
(princ (ssg-textf "vfc-winkel-option-horizontal"
(list idx (chr 176)
(rtos (nth 1 eintrag) 2 1) (rtos (nth 2 eintrag) 2 1))))
(princ (ssg-textf "vfc-winkel-option"
(list idx (itoa w) (chr 176)
(rtos (nth 1 eintrag) 2 1) (rtos (nth 2 eintrag) 2 1))))
)
(setq idx (1+ idx))
)
(setq wahl (getint (strcat "Winkel waehlen (1-"
(itoa (length gueltige-winkel)) ") [1]: ")))
(setq wahl (getint (ssg-textf "vfc-prompt-winkel-waehlen"
(list (length gueltige-winkel)))))
(if (or (null wahl) (< wahl 1) (> wahl (length gueltige-winkel)))
(setq wahl 1))
(setq best-winkel (nth (1- wahl) gueltige-winkel))
@@ -1372,22 +1360,20 @@
)
(princ "\n\n=========================================")
(if (= best-winkel 0)
(princ (strcat "\n>>> Horizontale Variofoerderer"
" L_GF: " (rtos L_GF 2 2) " mm"
" L_VF: " (rtos L_VF 2 2) " mm"))
(princ (strcat "\n>>> Winkel: " (itoa best-winkel) (chr 176)
" L_GF: " (rtos L_GF 2 2) " mm"
" L_VF: " (rtos L_VF 2 2) " mm"))
(princ (ssg-textf "vfc-zus-horizontal"
(list (rtos L_GF 2 2) (rtos L_VF 2 2))))
(princ (ssg-textf "vfc-zus-winkel"
(list (itoa best-winkel) (chr 176) (rtos L_GF 2 2) (rtos L_VF 2 2))))
)
(princ "\n=========================================")
;; 9. L_GF Verteilung
(princ "\n\nVerteilung der Gefaellestrecken (vorne/hinten):")
(princ "\n 1 - Gleichmaessig (L_GF1 = L_GF2 = L_GF/2)")
(princ "\n 2 - Vorne Minimum, hinten Rest")
(princ "\n 3 - Hinten Minimum, vorne Rest")
(princ "\n 4 - Eigene Werte eingeben")
(setq verteilung-modus (getstring "\nIhre Wahl (1/2/3/4) [1]: "))
(princ (ssg-text "vfc-gf-verteilung-header"))
(princ (ssg-text "vfc-gf-verteilung-1"))
(princ (ssg-text "vfc-gf-verteilung-2"))
(princ (ssg-text "vfc-gf-verteilung-3"))
(princ (ssg-text "vfc-gf-verteilung-4"))
(setq verteilung-modus (getstring (ssg-text "prompt-wahl-1-2-3-4")))
(if (= verteilung-modus "") (setq verteilung-modus "1"))
(cond
((= verteilung-modus "1")
@@ -1399,23 +1385,22 @@
(setq L_GF2 (float staustrecke-basis))
(setq L_GF1 (max 0.0 (- L_GF (float staustrecke-basis)))))
((= verteilung-modus "4")
(setq L_GF1 (getreal (strcat "\nL_GF1 vorne (mm) ["
(rtos (/ L_GF 2.0) 2 2) "]: ")))
(setq L_GF1 (getreal (ssg-textf "vfc-prompt-lgf1-vorne"
(list (rtos (/ L_GF 2.0) 2 2)))))
(if (null L_GF1) (setq L_GF1 (/ L_GF 2.0)))
(setq L_GF2 (max 0.0 (- L_GF L_GF1)))
(princ (strcat "\n L_GF2 hinten: " (rtos L_GF2 2 2) " mm")))
(princ (ssg-textf "vfc-lgf2-hinten" (list (rtos L_GF2 2 2)))))
(t (setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
)
(princ (strcat "\n>>> L_GF1=" (rtos L_GF1 2 2)
" mm L_GF2=" (rtos L_GF2 2 2) " mm"))
(princ (ssg-textf "vfc-zus-lgf" (list (rtos L_GF1 2 2) (rtos L_GF2 2 2))))
;; Scanner-Anzahl wird nicht mehr abgefragt (Attribut ANZAHL_SCANNER bleibt 0).
(setq n-scanner 0)
;; 11. Bestaetigung
(princ "\n\nMoechten Sie die Foerderanlage einfuegen?")
(princ "\n 1 - Ja, Module einfuegen\n 2 - Nein, abbrechen")
(setq antwort (getstring "\nIhre Wahl (1/2): "))
(princ (ssg-text "vfc-einfuegen-frage"))
(princ (ssg-text "vfc-einfuegen-optionen"))
(setq antwort (getstring (ssg-text "vfc-prompt-wahl-1-2-ohne-default")))
(if (= antwort "1")
(progn
@@ -1440,7 +1425,7 @@
(princ "\n=========================================")
)
(princ "\nVorgang abgebrochen.")
(princ (ssg-text "vfc-vorgang-abgebrochen"))
)
nil
)
Lisp/vf_etage.lsp
+69 -79
View File
@@ -21,7 +21,7 @@
(if *vf-etage-core-pfad*
(load (strcat *vf-etage-core-pfad* "/vf_core.lsp"))
(progn
(princ "\n[vf_etage] WARNUNG: Lisp-Pfad nicht ermittelbar - vf_core.lsp nicht ladbar!")
(princ (ssg-text "vfe-warn-lisp-pfad"))
(exit)
)
)
@@ -50,9 +50,9 @@
(if (and *etage-lib-initialized* (not (tblsearch "BLOCK" "AS_Element_30_rechts")))
(setq *etage-lib-initialized* nil))
(if *etage-lib-initialized*
(progn (princ "\n Etage-Bibliothek bereits initialisiert.") t)
(progn (princ (ssg-text "vfe-bib-bereits-init")) t)
(progn
(princ "\n Initialisiere Etage-Bibliothek...")
(princ (ssg-text "vfe-bib-initialisiere"))
;; Standard-Bogen-Daten laden (bogen-auf/bogen-ab benoetigt)
(if (not *lib-initialized*)
@@ -60,7 +60,7 @@
)
;; AS_30_rechts Masse extrahieren
(princ "\n Extrahiere AS_30_rechts Masse...")
(princ (ssg-text "vfe-extrahiere-as30"))
(ensure-block-loaded "AS_Element_30_rechts")
(ensure-block-loaded "AS_Element_30_links")
(if (tblsearch "BLOCK" "AS_Element_30_rechts")
@@ -79,23 +79,22 @@
(progn
(setq etage-aus-dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
(setq etage-aus-dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
(princ (strcat "\n AS_30_rechts: dx=" (rtos etage-aus-dx 2 1)
" mm, dz=" (rtos etage-aus-dz 2 1) " mm"))
(princ (ssg-textf "vfe-as30-mass" (list (rtos etage-aus-dx 2 1) (rtos etage-aus-dz 2 1))))
)
(progn
(princ "\n WARNUNG: KS fehlt - Standardwerte")
(princ (ssg-text "vfe-warn-ks-fehlt-standard"))
(setq etage-aus-dx 525.8 etage-aus-dz -72.9)
)
)
)
(progn
(princ "\n WARNUNG: Block AS_Element_30_rechts fehlt - Standardwerte")
(princ (ssg-text "vfe-warn-block-as30-fehlt"))
(setq etage-aus-dx 525.8 etage-aus-dz -72.9)
)
)
;; ES_30_rechts Masse extrahieren
(princ "\n Extrahiere ES_30_rechts Masse...")
(princ (ssg-text "vfe-extrahiere-es30"))
(ensure-block-loaded "ES_Element_30_rechts")
(ensure-block-loaded "ES_Element_30_links")
(if (tblsearch "BLOCK" "ES_Element_30_rechts")
@@ -114,24 +113,23 @@
(progn
(setq etage-ein-dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
(setq etage-ein-dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
(princ (strcat "\n ES_30_rechts: dx=" (rtos etage-ein-dx 2 1)
" mm, dz=" (rtos etage-ein-dz 2 1) " mm"))
(princ (ssg-textf "vfe-es30-mass" (list (rtos etage-ein-dx 2 1) (rtos etage-ein-dz 2 1))))
)
(progn
(princ "\n WARNUNG: KS fehlt - Standardwerte")
(princ (ssg-text "vfe-warn-ks-fehlt-standard"))
(setq etage-ein-dx 576.2 etage-ein-dz -54.6)
)
)
)
(progn
(princ "\n WARNUNG: Block ES_Element_30_rechts fehlt - Standardwerte")
(princ (ssg-text "vfe-warn-block-es30-fehlt"))
(setq etage-ein-dx 576.2 etage-ein-dz -54.6)
)
)
;; Gefaellebogen_links_60 Masse extrahieren
(setq gefaelle-blockname "Gefaellebogen_links_60_R500")
(princ (strcat "\n Extrahiere " gefaelle-blockname " Masse..."))
(princ (ssg-textf "vfe-extrahiere-block-mass" (list gefaelle-blockname)))
(ensure-block-loaded gefaelle-blockname)
(if (tblsearch "BLOCK" gefaelle-blockname)
(progn
@@ -150,22 +148,21 @@
(setq etage-gef-dz-links (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
)
(progn
(princ "\n WARNUNG: kein KS - Standardwerte (links)")
(princ (ssg-text "vfe-warn-kein-ks-links"))
(setq etage-gef-dx-links 0.0 etage-gef-dz-links -10.0)
)
)
)
(progn
(princ "\n WARNUNG: Block fehlt - Standardwerte (links)")
(princ (ssg-text "vfe-warn-block-fehlt-links"))
(setq etage-gef-dx-links 0.0 etage-gef-dz-links -10.0)
)
)
(princ (strcat "\n Gefaellebogen links: dx=" (rtos etage-gef-dx-links 2 2)
" dz=" (rtos etage-gef-dz-links 2 2) " mm"))
(princ (ssg-textf "vfe-gefaellebogen-links-mass" (list (rtos etage-gef-dx-links 2 2) (rtos etage-gef-dz-links 2 2))))
;; Gefaellebogen_rechts_60 Masse extrahieren
(setq gefaelle-blockname "Gefaellebogen_rechts_60_R500")
(princ (strcat "\n Extrahiere " gefaelle-blockname " Masse..."))
(princ (ssg-textf "vfe-extrahiere-block-mass" (list gefaelle-blockname)))
(ensure-block-loaded gefaelle-blockname)
(if (tblsearch "BLOCK" gefaelle-blockname)
(progn
@@ -184,21 +181,20 @@
(setq etage-gef-dz-rechts (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
)
(progn
(princ "\n WARNUNG: kein KS - Standardwerte (rechts)")
(princ (ssg-text "vfe-warn-kein-ks-rechts"))
(setq etage-gef-dx-rechts 0.0 etage-gef-dz-rechts -10.0)
)
)
)
(progn
(princ "\n WARNUNG: Block fehlt - Standardwerte (rechts)")
(princ (ssg-text "vfe-warn-block-fehlt-rechts"))
(setq etage-gef-dx-rechts 0.0 etage-gef-dz-rechts -10.0)
)
)
(princ (strcat "\n Gefaellebogen rechts: dx=" (rtos etage-gef-dx-rechts 2 2)
" dz=" (rtos etage-gef-dz-rechts 2 2) " mm"))
(princ (ssg-textf "vfe-gefaellebogen-rechts-mass" (list (rtos etage-gef-dx-rechts 2 2) (rtos etage-gef-dz-rechts 2 2))))
(setq *etage-lib-initialized* t)
(princ "\n Etage-Bibliothek erfolgreich initialisiert.")
(princ (ssg-text "vfe-bib-init-erfolg"))
t
)
)
@@ -223,7 +219,7 @@
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
(princ (ssg-textf "vfe-block-fehlt-abbruch" (list blockname)))
(exit)
)
)
@@ -241,10 +237,11 @@
(+ (car startpunkt) (* laenge chz cv))
(+ (cadr startpunkt) (* laenge shz cv))
(+ (caddr startpunkt) (* (- sv) laenge))))
(princ (strcat "\n HzIncl " blockname " L=" (rtos laenge 2 0)
" hz=" (rtos hz-winkel 2 0) (chr 176)
" v=" (rtos vert-winkel 2 0) (chr 176)
" -> Z=" (rtos (caddr endpunkt) 2 1)))
(princ (ssg-textf "vfe-hz-incl-status"
(list blockname (rtos laenge 2 0)
(strcat (rtos hz-winkel 2 0) (chr 176))
(strcat (rtos vert-winkel 2 0) (chr 176))
(rtos (caddr endpunkt) 2 1))))
endpunkt
)
@@ -258,7 +255,7 @@
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
(princ (ssg-textf "vfe-block-fehlt-abbruch" (list blockname)))
(exit)
)
)
@@ -276,10 +273,11 @@
(+ (car startpunkt) (+ (* block-dx chz cv) (* block-dz chz sv)))
(+ (cadr startpunkt) (+ (* block-dx shz cv) (* block-dz shz sv)))
(+ (caddr startpunkt) (+ (* (- sv) block-dx) (* cv block-dz)))))
(princ (strcat "\n HzRot " blockname
" hz=" (rtos hz-winkel 2 0) (chr 176)
" v=" (rtos vert-winkel 2 0) (chr 176)
" -> Z=" (rtos (caddr endpunkt) 2 1)))
(princ (ssg-textf "vfe-hz-rot-status"
(list blockname
(strcat (rtos hz-winkel 2 0) (chr 176))
(strcat (rtos vert-winkel 2 0) (chr 176))
(rtos (caddr endpunkt) 2 1))))
endpunkt
)
@@ -291,7 +289,7 @@
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
(princ (ssg-textf "vfe-block-fehlt-abbruch" (list blockname)))
(exit)
)
)
@@ -335,13 +333,14 @@
(setq ausgang (list (+ (car p-aus-rot) (car offset))
(+ (cadr p-aus-rot) (cadr offset))
(+ (caddr p-aus-rot) (caddr offset))))
(princ (strcat "\n HzRotKS " blockname
" hz=" (rtos hz-winkel 2 0) (chr 176)
" -> Z=" (rtos (caddr ausgang) 2 1)))
(princ (ssg-textf "vfe-hz-rotks-status"
(list blockname
(strcat (rtos hz-winkel 2 0) (chr 176))
(rtos (caddr ausgang) 2 1))))
ausgang
)
(progn
(princ (strcat "\n WARNUNG: KS fehlt in '" blockname "' - verwende Startpunkt"))
(princ (ssg-textf "vfe-ks-fehlt-startpunkt" (list blockname)))
startpunkt
)
)
@@ -355,7 +354,7 @@
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
(princ (ssg-textf "vfe-block-fehlt-abbruch" (list blockname)))
(exit)
)
)
@@ -403,14 +402,14 @@
(setq ausgang (list (+ (car p-aus-rot) (car offset))
(+ (cadr p-aus-rot) (cadr offset))
(+ (caddr p-aus-rot) (caddr offset))))
(princ (strcat "\n HzScaleKS " blockname
" " (rtos laenge 2 0) "mm"
" hz=" (rtos hz-winkel 2 0) (chr 176)
" -> Z=" (rtos (caddr ausgang) 2 1)))
(princ (ssg-textf "vfe-hz-scaleks-status"
(list blockname (rtos laenge 2 0)
(strcat (rtos hz-winkel 2 0) (chr 176))
(rtos (caddr ausgang) 2 1))))
ausgang
)
(progn
(princ (strcat "\n WARNUNG: KS fehlt in '" blockname "' - verwende Startpunkt"))
(princ (ssg-textf "vfe-ks-fehlt-startpunkt" (list blockname)))
startpunkt
)
)
@@ -432,7 +431,7 @@
(if (not *etage-lib-initialized*)
(progn
(alert "Etage-Bibliothek nicht initialisiert!")
(alert (ssg-text "vfe-alert-bib-nicht-init"))
(exit)
)
)
@@ -452,11 +451,9 @@
(setq schraeg-cos (* (cos schraeg-hz-rad) cos3))
(princ "\n\n=========================================")
(princ "\n ETAGE-BERECHNUNG FUER ALLE WINKEL")
(princ (ssg-text "vfe-berechnung-header"))
(princ "\n=========================================")
(princ (strcat "\n△L=" (rtos deltaL 2 2) " mm"
" △H=" (rtos deltaH 2 2) " mm"
" Richtung=" richtung))
(princ (ssg-textf "vfe-delta-info" (list (rtos deltaL 2 2) (rtos deltaH 2 2) richtung)))
(foreach winkel winkel-list
(if (= richtung "Auf")
@@ -471,7 +468,7 @@
)
(if (or (null mass1) (null mass2))
(progn
(princ (strcat "\n " (itoa winkel) (chr 176) " -> Bogen nicht vorhanden"))
(princ (ssg-textf "vfe-bogen-nicht-vorhanden" (list (strcat (itoa winkel) (chr 176)))))
(setq ergebnis-liste (cons (list winkel nil nil nil) ergebnis-liste))
)
(progn
@@ -540,9 +537,9 @@
(setq ergebnis-liste (reverse ergebnis-liste))
(princ "\n\n=================================================================================")
(princ "\n ERGEBNISTABELLE (L_GF = gesamt beider GF-Strecken)")
(princ (ssg-text "vfe-ergebnistabelle-header"))
(princ "\n=================================================================================")
(princ "\n Winkel L_GF (mm) L_VF (mm) Status")
(princ (ssg-text "vfe-tabelle-spalten"))
(princ "\n=================================================================================")
(setq best-winkel nil best-L_GF nil best-L_VF nil)
@@ -553,26 +550,25 @@
gueltig (cadddr item))
(if (and (numberp L_GF) (numberp L_VF))
(progn
(princ (strcat "\n " (itoa winkel) (chr 176)
" " (fmt L_GF) " mm " (fmt L_VF) " mm "))
(princ (ssg-textf "vfe-tabelle-zeile"
(list (strcat (itoa winkel) (chr 176)) (fmt L_GF) (fmt L_VF))))
(if gueltig
(progn
(princ "GUELTIG")
(princ (ssg-text "vfe-status-gueltig"))
(if (or (null best-winkel) (< winkel best-winkel))
(setq best-winkel winkel best-L_GF L_GF best-L_VF L_VF)
)
)
(princ "UNGUELTIG (negative Laenge)")
(princ (ssg-text "vfe-status-ungueltig"))
)
)
(princ (strcat "\n " (itoa winkel) (chr 176)
" --- --- FEHLER"))
(princ (ssg-textf "vfe-tabelle-zeile-fehler" (list (strcat (itoa winkel) (chr 176)))))
)
)
(princ "\n=================================================================================")
(if best-winkel
(princ (strcat "\n>>> Empfohlener Winkel: " (itoa best-winkel) (chr 176)))
(princ "\n>>> KEIN passender Winkel gefunden!")
(princ (ssg-textf "vfe-empfohlener-winkel" (list (strcat (itoa best-winkel) (chr 176)))))
(princ (ssg-text "vfe-kein-winkel-gefunden"))
)
(list best-winkel best-L_GF best-L_VF ergebnis-liste)
)
@@ -592,8 +588,7 @@
(setq etage-gef-dx etage-gef-dx-links)
(setq etage-gef-dz etage-gef-dz-links))
)
(princ (strcat "\n Gefaellebogen " seite
": dx=" (rtos etage-gef-dx 2 2) " mm"))
(princ (ssg-textf "vfe-gefaellebogen-seite-dx" (list seite (rtos etage-gef-dx 2 2))))
(berechne-winkel-etage deltaL deltaH richtung)
)
@@ -634,41 +629,38 @@
(if (not *etage-lib-initialized*) (init-bibliothek-etage))
;; 1. AS_30
(princ (strcat "\n\n1/15: " as-block " (0 Grad)"))
(princ (ssg-textf "vfe-step1-as30" (list as-block)))
(setq aktueller-punkt (insert-block-by-ks as-block aktueller-punkt 0.0))
;; 2. Staustrecke 400mm (hz-anfang, 3 Grad vert, KS_EIN)
(princ (strcat "\n\n2/15: Staustrecke 400mm ("
(itoa hz-anfang) " Grad hz, 3 Grad vert, KS_EIN)"))
(princ (ssg-textf "vfe-step2" (list (itoa hz-anfang))))
(setq aktueller-punkt
(insert-hz-scaled-block-by-ks "Staustrecke_SP_1000_mm" aktueller-punkt
400 hz-anfang 3))
;; 3. Separator (hz-anfang, 3 Grad vert)
(princ (strcat "\n\n3/15: Separator (300mm, "
(itoa hz-anfang) " Grad hz, 3 Grad vert)"))
(princ (ssg-textf "vfe-step3" (list (itoa hz-anfang))))
(setq aktueller-punkt
(insert-hz-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt
hz-anfang 3 300 0))
;; 4. Gefaellebogen Anfang (hz-anfang, 0 Grad vert, KS_EIN)
(princ (strcat "\n\n4/15: " gefaelle-blockname
" (Anfang, " (itoa hz-anfang) " Grad hz, 0 Grad vert, KS_EIN)"))
(princ (ssg-textf "vfe-step4" (list gefaelle-blockname (itoa hz-anfang))))
(setq aktueller-punkt
(insert-hz-rotated-block-by-ks gefaelle-blockname aktueller-punkt hz-anfang 0))
;; 5. L_GF1 (3 Grad geneigt)
(if (> L_GF1 0.1)
(progn
(princ (strcat "\n\n5/15: Gefaellestrecke (3 Grad, L=" (rtos L_GF1 2 2) " mm)"))
(princ (ssg-textf "vfe-step5-strecke" (list (rtos L_GF1 2 2))))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_GF1 3 0.0))
)
(princ "\n\n5/15: L_GF1 (uebersprungen)")
(princ (ssg-text "vfe-step5-skip"))
)
;; 6. Umlenkstation (3 Grad geneigt)
(princ "\n\n6/15: Umlenkstation (500mm, 3 Grad geneigt)")
(princ (ssg-text "vfe-step6"))
(setq aktueller-punkt
(insert-rotated-block-with-ks "Vario_Umlenkstation_500mm" aktueller-punkt 3 500 0 0.0))
@@ -684,7 +676,7 @@
)
)
(setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass))
(princ (strcat "\n\n7/15: " bogen-name " (3 Grad geneigt)"))
(princ (ssg-textf "vfe-step7" (list bogen-name)))
(setq aktueller-punkt
(insert-rotated-block-with-ks bogen-name aktueller-punkt 3 bogen-dx bogen-dz 0.0))
@@ -693,22 +685,20 @@
(progn
(if (= richtung "Auf")
(progn
(princ (strcat "\n\n8/15: Steigungsstrecke ("
(itoa (- (- best-winkel 3))) " Grad, L=" (rtos L_VF 2 2) " mm)"))
(princ (ssg-textf "vfe-step8-auf" (list (itoa (- (- best-winkel 3))) (rtos L_VF 2 2))))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_VF (- (- best-winkel 3)) 0.0))
)
(progn
(princ (strcat "\n\n8/15: Gefaellestrecke ("
(itoa (+ best-winkel 3)) " Grad, L=" (rtos L_VF 2 2) " mm)"))
(princ (ssg-textf "vfe-step8-ab" (list (itoa (+ best-winkel 3)) (rtos L_VF 2 2))))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_VF (+ best-winkel 3) 0.0))
)
)
)
(princ "\n\n8/15: L_VF (uebersprungen)")
(princ (ssg-text "vfe-step8-skip"))
)
;; 9. 2. Vertikalbogen
Lisp/vf_linienzug.lsp
+109 -99
View File
@@ -129,13 +129,13 @@
((= (length gueltige) 1)
(setq e (car gueltige)) (list (nth 0 e) (nth 1 e) (nth 2 e)))
(t
(princ "\n\nMehrere gueltige Winkel - bitte gewuenschten Winkel waehlen:")
(princ (ssg-text "vfl-mehrere-winkel-header"))
(setq idx 1)
(foreach e gueltige
(princ (strcat "\n " (itoa idx) " - " (itoa (car e)) " Grad"
" (L_GF=" (rtos (cadr e) 2 1) " mm L_VF=" (rtos (caddr e) 2 1) " mm)"))
(princ (ssg-textf "vfl-winkel-option"
(list idx (car e) (rtos (cadr e) 2 1) (rtos (caddr e) 2 1))))
(setq idx (1+ idx)))
(setq antwort (getint (strcat "\nIhre Wahl (1-" (itoa (length gueltige)) ") [1]: ")))
(setq antwort (getint (ssg-textf "vfl-prompt-wahl-bis-n" (list (length gueltige)))))
(if (or (null antwort) (< antwort 1) (> antwort (length gueltige))) (setq antwort 1))
(setq e (nth (1- antwort) gueltige))
(list (nth 0 e) (nth 1 e) (nth 2 e)))))
@@ -280,8 +280,7 @@
(defun vfl-20m-check (p-umlenk p-akt / laenge)
(setq laenge (vfl-planar-dist p-umlenk p-akt))
(if (> laenge 20000.0)
(princ (strcat "\n >>> HINWEIS: Foerderer laenger als 20 m ("
(rtos (/ laenge 1000.0) 2 2) " m) - Motorstation empfohlen!"))
(princ (ssg-textf "vfl-20m-hinweis" (list (rtos (/ laenge 1000.0) 2 2))))
)
)
@@ -304,7 +303,7 @@
;; horizontale Stueck, wo der Separator in der 0-Grad-Ebene liegt (NICHT auf der
;; 3-Grad-Basis wie vfl-insert-separator). Rueckgabe: Endpunkt.
(defun vfl-sep-hz (pt hz / ep)
(princ "\n [horizontal] Separator (300 mm, 0 Grad)")
(princ (ssg-text "vfl-sep-horizontal-info"))
(setq ep (gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm" pt hz 0 300 0))
(setq *vfl-acc-separator* (1+ *vfl-acc-separator*))
ep)
@@ -319,7 +318,7 @@
(progn
(setq hz (car (frame->hz-winkel frame)))
(setq m (get-bogen-mass bogen-ab 3))
(princ "\n\nVario_Bogen_ab_3 (Uebergang horizontal -> 3 Grad)")
(princ (ssg-text "vfl-bogen-ab3-uebergang"))
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_ab_3" (car frame)
0 (car m) (caddr m) hz))
(vfl-frame-3grad pt hz))
@@ -333,26 +332,28 @@
;; VOR/NACH liegen in der 0-Grad-Ebene. Rueckgabe: neuer Frame (flach, 0 Grad).
(defun vfl-baue-horizontal-koerper (frame hz dL / pt m1 sep-vor)
(setq pt (car frame))
(princ "\n\nZusaetzlichen Separator VOR dem horizontalen Stueck?")
(princ "\n 1 - Ja\n 2 - Nein")
(setq sep-vor (= (getstring "\nIhre Wahl (1/2) [2]: ") "1"))
(princ (ssg-text "vfl-sep-vor-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-nein"))
(setq sep-vor (= (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")) "1"))
;; auf_3-Eintritt nur, wenn noch NICHT flach (sonst flache Zone fortsetzen)
(if (not (vfl-frame-flach-p frame))
(progn
(setq m1 (get-bogen-mass bogen-auf 3))
(princ "\n\nVario_Bogen_auf_3 (Uebergang 3 Grad -> horizontal)")
(princ (ssg-text "vfl-bogen-auf3-uebergang"))
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_auf_3" pt
(ssg-cfg-or "vario" "gefaelle_winkel" 3) (car m1) (caddr m1) hz))))
;; optionaler Separator VOR - in der horizontalen Ebene (0 Grad)
(if sep-vor (setq pt (vfl-sep-hz pt hz)))
;; horizontale Zwischenstrecke (0 Grad)
(princ (strcat "\n\nHorizontale Zwischenstrecke (0 Grad, L=" (rtos dL 2 2) " mm)"))
(princ (ssg-textf "vfl-horizontale-zwischenstrecke" (list (rtos dL 2 2))))
(setq pt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" pt dL 0 hz))
(vfl-acc-vf-seg "horizontal" 0 dL)
;; optionaler Separator NACH - ebenfalls horizontal (0 Grad)
(princ "\n\nZusaetzlichen Separator NACH dem horizontalen Stueck?")
(princ "\n 1 - Ja\n 2 - Nein")
(if (= (getstring "\nIhre Wahl (1/2) [2]: ") "1") (setq pt (vfl-sep-hz pt hz)))
(princ (ssg-text "vfl-sep-nach-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-nein"))
(if (= (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")) "1") (setq pt (vfl-sep-hz pt hz)))
;; KEIN ab_3 mehr -> das Stueck ENDET FLACH (0 Grad)
(make-frame-from-dir pt (hz-winkel->xu hz 0.0))
)
@@ -434,24 +435,23 @@
(setq frame (vfl-nach-3grad frame))
(setq linie-mess (vfl-neue-linie-messen (car frame) letzt-hz))
(if (null linie-mess)
(progn (princ "\n Abgebrochen - kein Zielpunkt gewaehlt.") nil)
(progn (princ (ssg-text "vfl-abgebrochen-kein-ziel")) nil)
(progn
(setq dL (car linie-mess) hzn (cadr linie-mess))
(setq hn (getreal (strcat "\nHoehe (Z) des Kettenendes (ES-Element) ["
(rtos (caddr (car frame)) 2 1) "]: ")))
(setq hn (getreal (ssg-textf "vfl-prompt-hoehe-kettenende"
(list (rtos (caddr (car frame)) 2 1)))))
(if (null hn) (setq hn (caddr (car frame))))
(setq dH (- hn (caddr (car frame))))
(setq richtn (if (>= dH 0.0) "Auf" "Ab"))
(setq dH (abs dH))
(setq rad3 (* (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)) (/ pi 180.0)))
(princ (strcat "\n>>> Kettenende-Modus: Ziel dL=" (rtos dL 2 0)
" mm, dH=" (rtos dH 2 0) " mm (" richtn "). GF2 variiert mit dem Winkel."))
(princ (ssg-textf "vfl-kettenende-modus-ziel"
(list (rtos dL 2 0) (rtos dH 2 0) richtn)))
(setq dec (vfl-body-zerlegung dL dH richtn))
(setq typ (nth 0 dec) w (nth 1 dec) lgf (nth 2 dec) lvf (nth 3 dec))
(if (null typ)
(progn
(princ (strcat "\n FEHLER: Rest nicht baubar (zu steil/zu kurz fuer"
" Schwanz Motor+GF2+Separator+ES). Bitte weiter zeichnen oder flacher planen."))
(princ (ssg-text "vfl-fehler-rest-nicht-baubar"))
nil)
(progn
;; Soll-ES-Punkt fuer den Ist-Ziel-Report merken (Startpunkt +
@@ -479,9 +479,8 @@
(t 0.0)))
(if (and (> gf2 0.0) (< gf2 *vfl-gf-min-laenge*))
(progn
(princ (strcat "\n HINWEIS: berechnetes GF2=" (rtos gf2 2 0)
" mm < Minimum " (rtos *vfl-gf-min-laenge* 2 0)
" mm -> auf Minimum angehoben (ES endet dadurch etwas weiter; siehe Ist-Ziel-Report)."))
(princ (ssg-textf "vfl-hinweis-gf2-minimum"
(list (rtos gf2 2 0) (rtos *vfl-gf-min-laenge* 2 0))))
(setq gf2 *vfl-gf-min-laenge*)))
(list frame cnt hzn gf2)
)
@@ -523,11 +522,11 @@
;; --- Fortsetzungs-Schleife bis Foerderer-Ende ---
(setq fertig nil)
(while (not fertig)
(princ "\n\nIst der Endpunkt der Foerderer?")
(princ "\n 1 - Ja (nur Motorstation setzen)")
(princ "\n 2 - Nein (weiterbauen)")
(princ "\n 3 - Ja (Motorstation setzen, Kettenende definieren)")
(setq antwort (getstring "\nIhre Wahl (1/2/3) [2]: "))
(princ (ssg-text "vfl-ist-endpunkt-frage"))
(princ (ssg-text "vfl-ja-nur-motorstation"))
(princ (ssg-text "vfl-nein-weiterbauen"))
(princ (ssg-text "vfl-ja-motorstation-kettenende"))
(setq antwort (getstring (ssg-text "vfl-prompt-wahl-1-3-def2")))
(if (= antwort "1")
(setq fertig t)
(if (= antwort "3")
@@ -542,11 +541,11 @@
ziel-ende t
fertig t)))
(progn
(princ "\n\nNaechstes Element im VarioFoerderer:")
(princ "\n 1 - Horizontaler Foerderer (Linie ohne Hoehendifferenz)")
(princ "\n 2 - Vario-Kurve (30/60/90 Grad)")
(princ "\n 3 - Auf/Ab-Foerderer (Linie mit Hoehendifferenz)")
(setq antwort (getstring "\nIhre Wahl (1/2/3) [3]: "))
(princ (ssg-text "vfl-naechstes-element-vf"))
(princ (ssg-text "vfl-opt-horizontaler-foerderer"))
(princ (ssg-text "vfl-opt-vario-kurve"))
(princ (ssg-text "vfl-opt-auf-ab-foerderer"))
(setq antwort (getstring (ssg-text "vfl-prompt-wahl-1-3-def3")))
(cond
;; --- Vario-Kurve (aendert hz) ---
((= antwort "2")
@@ -566,7 +565,7 @@
(setq vf-count (1+ vf-count) letzt-hz hzn)
(vfl-20m-check p-umlenk (car frame))
)
(princ "\n Linie zu kurz (oder entgegen der Fahrtrichtung) - uebersprungen.")
(princ (ssg-text "vfl-linie-zu-kurz-uebersprungen"))
)
)
)
@@ -581,8 +580,8 @@
(setq dL (car linie-mess) hzn (cadr linie-mess))
(if (> dL 1.0)
(progn
(setq hn (getreal (strcat "\nHoehe (Z) des Endpunkts ["
(rtos (caddr (car frame)) 2 1) "]: ")))
(setq hn (getreal (ssg-textf "vfl-prompt-hoehe-endpunkt"
(list (rtos (caddr (car frame)) 2 1)))))
(if (null hn) (setq hn (caddr (car frame))))
(setq dH (- hn (caddr (car frame))))
(setq richtn (if (>= dH 0.0) "Auf" "Ab"))
@@ -596,12 +595,10 @@
(vfl-acc-vf-seg richtn w lvf)
(vfl-20m-check p-umlenk (car frame))
)
(princ (strcat "\n Segment waere GF (zu steil) oder nicht baubar - "
"innerhalb einer VF-Einheit nicht erlaubt.\n"
" Bitte flacher/steigend zeichnen oder Foerderer beenden."))
(princ (ssg-text "vfl-segment-gf-nicht-erlaubt"))
)
)
(princ "\n Linie zu kurz - uebersprungen.")
(princ (ssg-text "vfl-linie-zu-kurz-simple"))
)
)
)
@@ -634,11 +631,11 @@
;; GF-Bogen (horizontale Kurve, Neigung bleibt wie im aktuellen Frame).
;; Fragt Winkel (30/60/90) und Seite interaktiv ab.
;; Nicht-interaktiver Kern: GF-Bogen mit gegebenem Winkel/Seite einfuegen.
;; Wird von der interaktiven Abfrage (vfl-insert-gf-bogen) UND von Modus 2
;; (Winkel/Seite aus der Pfad-Geometrie) genutzt. Rueckgabe: neuer Frame.
;; Genutzt von der interaktiven Abfrage UND von den Pfad-Modi (Winkel/Seite
;; aus der Geometrie). Rueckgabe: neuer Frame.
(defun vfl-insert-gf-bogen-block (frame bwinkel bseite / blockname)
(setq blockname (gf-bogen-blockname bwinkel bseite))
(princ (strcat "\n Fuege " blockname " ein ..."))
(princ (ssg-textf "vfl-fuege-block-ein" (list blockname)))
;; GF-Bogen zaehlen (Seite L/R + Winkel) -> Attribut GF_Bogen_L/R_xx
(setq *vfl-acc-gfbogen*
(vfl-inc-count *vfl-acc-gfbogen*
@@ -646,15 +643,19 @@
(insert-block-ks-to-ks blockname frame)
)
;; Interaktiv (i18n): GF-Bogen-Winkel + Seite abfragen, dann Kern aufrufen.
(defun vfl-insert-gf-bogen (frame / bwinkel bseite antwort)
(princ "\n\nGF-Bogen - Winkel waehlen:")
(princ "\n 1 - 30 Grad\n 2 - 60 Grad\n 3 - 90 Grad")
(setq antwort (getint "\nIhre Wahl (1/2/3) [3]: "))
(princ (ssg-text "vfl-gf-bogen-winkel-header"))
(princ (ssg-text "vfl-winkel-30"))
(princ (ssg-text "vfl-winkel-60"))
(princ (ssg-text "vfl-winkel-90"))
(setq antwort (getint (ssg-text "vfl-prompt-wahl-1-3-def3")))
(if (null antwort) (setq antwort 3))
(setq bwinkel (cond ((= antwort 1) 30) ((= antwort 2) 60) (t 90)))
(princ "\nGF-Bogen - Seite waehlen:")
(princ "\n 1 - Links\n 2 - Rechts")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(princ (ssg-text "vfl-gf-bogen-seite-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(setq bseite (if (= antwort "2") "rechts" "links"))
(vfl-insert-gf-bogen-block frame bwinkel bseite)
)
@@ -665,11 +666,13 @@
)
;; Nicht-interaktiver Kern: Vario-Kurve mit gegebenem Winkel/Seite/Variante
;; einfuegen. Genutzt von der interaktiven Abfrage UND von Modus 2 (Winkel/Seite
;; aus der Pfad-Geometrie, Variante abgefragt). Rueckgabe: neuer Frame.
;; einfuegen. Genutzt von der interaktiven Abfrage UND von den Pfad-Modi
;; (Winkel/Seite aus der Geometrie, Variante abgefragt). Rueckgabe: neuer Frame.
;; Die Vario_Kurve-Bloecke fuehren KS_EIN/KS_AUS als KSYS_EIN/KSYS_AUS -
;; extract-ks-from-block-raw normalisiert das (siehe ks-normalize-name).
(defun vfl-insert-vario-kurve-block (frame kwinkel kseite kvariante / blockname hz flach-frame)
(setq blockname (vfl-kurve-blockname kwinkel kseite kvariante))
(princ (strcat "\n Fuege " blockname " ein ..."))
(princ (ssg-textf "vfl-fuege-block-ein" (list blockname)))
;; Vario-Kurve zaehlen (Variante A=aussen/I=innen + Winkel) -> VF_Bogen_A/I_xx
(setq *vfl-acc-variokurve*
(vfl-inc-count *vfl-acc-variokurve*
@@ -685,19 +688,24 @@
;; Vario-Kurve (horizontale Kurve, Neigung bleibt wie im aktuellen Frame).
;; Die Vario_Kurve-Bloecke fuehren KS_EIN/KS_AUS als KSYS_EIN/KSYS_AUS -
;; extract-ks-from-block-raw normalisiert das (siehe ks-normalize-name).
;; Interaktiv (i18n): Vario-Kurve-Winkel + Seite + Variante abfragen, dann Kern.
(defun vfl-insert-vario-kurve (frame / kwinkel kseite kvariante antwort)
(princ "\n\nVario-Kurve - Winkel waehlen:")
(princ "\n 1 - 90 Grad\n 2 - 60 Grad\n 3 - 30 Grad")
(setq antwort (getint "\nIhre Wahl (1/2/3) [1]: "))
(princ (ssg-text "vfl-variokurve-winkel-header"))
(princ (ssg-text "vfl-opt1-90grad"))
(princ (ssg-text "vfl-opt2-60grad"))
(princ (ssg-text "vfl-opt3-30grad"))
(setq antwort (getint (ssg-text "vfl-prompt-wahl-1-3-def1")))
(if (null antwort) (setq antwort 1))
(setq kwinkel (cond ((= antwort 1) 90) ((= antwort 2) 60) (t 30)))
(princ "\nVario-Kurve - Seite waehlen:")
(princ "\n 1 - Links\n 2 - Rechts")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(princ (ssg-text "vfl-variokurve-seite-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(setq kseite (if (= antwort "2") "rechts" "links"))
(princ "\nVario-Kurve - Variante waehlen:")
(princ "\n 1 - Aussen\n 2 - Innen")
(setq antwort (getstring "\nIhre Wahl (1/2) [2]: "))
(princ (ssg-text "vfl-variokurve-variante-header"))
(princ (ssg-text "vfl-variante-aussen"))
(princ (ssg-text "vfl-variante-innen"))
(setq antwort (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")))
(setq kvariante (if (= antwort "1") "aussen" "innen"))
(vfl-insert-vario-kurve-block frame kwinkel kseite kvariante)
)
@@ -735,10 +743,11 @@
;; ES-Winkel (30/90) + Seite erst am Kettenende abfragen. Setzt *vfl-es-winkel*
;; und die ES-Masse (ein-dx/dz) fuer die Variante. Rueckgabe: Seite (links/rechts).
(defun vfl-frage-es-seite ( / antwort es-seite)
(setq *vfl-es-winkel* (vf-frage-element-winkel "EIN-Element")) ; 30/90 vor Seite
(princ "\n\nEIN-Element (ES_Element_*) - Seite waehlen:")
(princ "\n 1 - Links\n 2 - Rechts")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(setq *vfl-es-winkel* (vf-frage-element-winkel "vf-winkel-ein-header")) ; 30/90 vor Seite
(princ (ssg-text "gf-seite-ein-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(setq es-seite (if (= antwort "2") "rechts" "links"))
(vf-set-es-masse *vfl-es-winkel* es-seite)
es-seite
@@ -860,7 +869,7 @@
;; Aufsteigende, eindeutige ID vergeben (wie beim Kreisel), falls verfuegbar.
(if (car (atoms-family 1 '("SSG-ID-GENERATE")))
(ssg-id-generate vfl-insert))
(princ (strcat "\n>>> Block '" vfl-bname "' (" typ-str ") erstellt und eingefuegt."))
(princ (ssg-textf "vfl-block-erstellt" (list vfl-bname typ-str)))
vfl-insert
)
@@ -874,10 +883,10 @@
(defun vfl-vf-einheit-abschluss (frame hz richtung winkel L_GF L_VF auto-ende /
antwort res es-s ende)
;; GF-Verteilung: halbe Staustrecke am Ausgang (GF2) oder alles am Einlauf.
(princ "\n\nStaustrecke (GF) - Verteilung waehlen:")
(princ "\n 1 - 1/2GF am Ausgang (GF2), 1/2GF am Einlauf (GF1)")
(princ "\n 2 - Gesamte Staustrecke am Einlauf (GF1), kein GF2")
(setq antwort (getstring "\nIhre Wahl (1/2) [2]: "))
(princ (ssg-text "vfl-gf-verteilung-header"))
(princ (ssg-text "vfl-gf-verteilung-haelfte"))
(princ (ssg-text "vfl-gf-verteilung-ganz-einlauf"))
(setq antwort (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")))
(setq res (vfl-vf-einheit frame hz richtung winkel L_GF L_VF (= antwort "1")))
(setq frame (nth 0 res))
;; Kettenende? Bei auto-ende (Kettenende-Modus) ohne Frage direkt ES setzen.
@@ -887,10 +896,10 @@
(if (or auto-ende (nth 2 res))
(setq antwort "1")
(progn
(princ "\n\nIst das das Kettenende (ES-Element)?")
(princ "\n 1 - Ja (Separator + ES-Element setzen)")
(princ "\n 2 - Nein (weiterbauen)")
(setq antwort (getstring "\nIhre Wahl (1/2) [2]: "))
(princ (ssg-text "vfl-ist-kettenende-frage"))
(princ (ssg-text "vfl-ja-separator-es"))
(princ (ssg-text "vfl-nein-weiterbauen"))
(setq antwort (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")))
)
)
(if (= antwort "1")
@@ -903,25 +912,28 @@
;; Ist-Ziel-Report (Option 3): Soll-ES (aus vfl-body-abschluss) vs. Ist-ES.
(if *vfl-ziel-punkt*
(progn
(princ "\n\n>>> IST-ZIEL-VERGLEICH (ES-Element):")
(princ (strcat "\n Soll: X=" (rtos (car *vfl-ziel-punkt*) 2 1)
" Y=" (rtos (cadr *vfl-ziel-punkt*) 2 1)
" Z=" (rtos (caddr *vfl-ziel-punkt*) 2 1)))
(princ (strcat "\n Ist : X=" (rtos (car (car frame)) 2 1)
" Y=" (rtos (cadr (car frame)) 2 1)
" Z=" (rtos (caddr (car frame)) 2 1)))
(princ (strcat "\n Abweichung: dX="
(rtos (- (car (car frame)) (car *vfl-ziel-punkt*)) 2 1)
" dY=" (rtos (- (cadr (car frame)) (cadr *vfl-ziel-punkt*)) 2 1)
" dZ=" (rtos (- (caddr (car frame)) (caddr *vfl-ziel-punkt*)) 2 1) " mm"))
(princ (ssg-text "vfl-ist-ziel-vergleich-header"))
(princ (ssg-textf "vfl-soll-xyz"
(list (rtos (car *vfl-ziel-punkt*) 2 1)
(rtos (cadr *vfl-ziel-punkt*) 2 1)
(rtos (caddr *vfl-ziel-punkt*) 2 1))))
(princ (ssg-textf "vfl-ist-xyz"
(list (rtos (car (car frame)) 2 1)
(rtos (cadr (car frame)) 2 1)
(rtos (caddr (car frame)) 2 1))))
(princ (ssg-textf "vfl-abweichung-xyz"
(list (rtos (- (car (car frame)) (car *vfl-ziel-punkt*)) 2 1)
(rtos (- (cadr (car frame)) (cadr *vfl-ziel-punkt*)) 2 1)
(rtos (- (caddr (car frame)) (caddr *vfl-ziel-punkt*)) 2 1))))
(setq *vfl-ziel-punkt* nil)
)
)
)
(progn
(princ "\n\nZusaetzlichen Separator an dieser Stelle einfuegen?")
(princ "\n 1 - Ja\n 2 - Nein")
(setq antwort (getstring "\nIhre Wahl (1/2) [2]: "))
(princ (ssg-text "vfl-sep-an-stelle-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-nein"))
(setq antwort (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")))
(if (= antwort "1") (setq frame (vfl-insert-separator frame)))
)
)
@@ -937,11 +949,9 @@
frame letzter-typ fertig linie-ende-modus rad3
anzahl-gf anzahl-vf vfl-nummer lastEnt)
(princ "\n\n=========================================")
(princ "\n VF-LINIENZUG - Modus 1: Manuelle Eingabe")
(princ (ssg-text "vfl-modus1-header"))
(princ "\n=========================================")
(princ "\nGemischte Gefaellestrecke/VarioFoerderer-Kette entlang eines frei")
(princ "\ngezeichneten Pfades. Kette beginnt immer mit AS_Element, endet immer")
(princ "\nmit ES_Element.")
(princ (ssg-text "vfl-modus1-beschreibung"))
;; Abhaengigkeit: die GF-Segmente/-Boegen nutzen Funktionen aus
;; Gefaellestrecke.lsp (gf-insert-hz-incl-scaled, gf-bogen-blockname, ...).
@@ -966,7 +976,7 @@
(if (null start-hoehe) (setq start-hoehe (caddr startpunkt)))
(setq startpunkt (list (car startpunkt) (cadr startpunkt) start-hoehe))
(setq *vfl-as-winkel* (vf-frage-element-winkel "AUS-Element")) ; 30/90 vor Seite
(setq *vfl-as-winkel* (vf-frage-element-winkel "vf-winkel-aus-header")) ; 30/90 vor Seite
(princ "\n\nAUS-Element (AS_Element_*) - Seite waehlen:")
(princ "\n 1 - Links\n 2 - Rechts")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
@@ -1408,7 +1418,7 @@
(rtos (caddr startpunkt) 2 1) "]: ")))
(if (null start-hoehe) (setq start-hoehe (caddr startpunkt)))
(setq startpunkt (list (car startpunkt) (cadr startpunkt) start-hoehe))
(setq *vfl-as-winkel* (vf-frage-element-winkel "AUS-Element")) ; 30/90 vor Seite
(setq *vfl-as-winkel* (vf-frage-element-winkel "vf-winkel-aus-header")) ; 30/90 vor Seite
(princ "\n\nAUS-Element - Seite waehlen:\n 1 - Links\n 2 - Rechts")
(setq as-seite (if (= (getstring "\nIhre Wahl (1/2) [1]: ") "2") "rechts" "links"))
(vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante
@@ -1805,7 +1815,7 @@
(rtos (caddr startpunkt) 2 1) "]: ")))
(if (null start-hoehe) (setq start-hoehe (caddr startpunkt)))
(setq startpunkt (list (car startpunkt) (cadr startpunkt) start-hoehe))
(setq *vfl-as-winkel* (vf-frage-element-winkel "AUS-Element")) ; 30/90 vor Seite
(setq *vfl-as-winkel* (vf-frage-element-winkel "vf-winkel-aus-header")) ; 30/90 vor Seite
(princ "\n\nAUS-Element - Seite waehlen:\n 1 - Links\n 2 - Rechts")
(setq as-seite (if (= (getstring "\nIhre Wahl (1/2) [1]: ") "2") "rechts" "links"))
(vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante
@@ -1817,7 +1827,7 @@
(rtos (caddr endpunkt) 2 1) "]: ")))
(if (null end-hoehe) (setq end-hoehe (caddr endpunkt)))
(setq endpunkt (list (car endpunkt) (cadr endpunkt) end-hoehe))
(setq *vfl-es-winkel* (vf-frage-element-winkel "EIN-Element")) ; 30/90 vor Seite
(setq *vfl-es-winkel* (vf-frage-element-winkel "vf-winkel-ein-header")) ; 30/90 vor Seite
(princ "\n\nEIN-Element (ES) - Seite waehlen:\n 1 - Links\n 2 - Rechts")
(setq es-seite (if (= (getstring "\nIhre Wahl (1/2) [1]: ") "2") "rechts" "links"))
(vf-set-es-masse *vfl-es-winkel* es-seite) ; Masse fuer Variante
Lisp/vf_standard.lsp
+42 -49
View File
@@ -21,7 +21,7 @@
(if *vf-std-core-pfad*
(load (strcat *vf-std-core-pfad* "/vf_core.lsp"))
(progn
(princ "\n[vf_standard] WARNUNG: Lisp-Pfad nicht ermittelbar - vf_core.lsp nicht ladbar!")
(princ (ssg-text "vfs-warn-lisppfad"))
(exit)
)
)
@@ -77,10 +77,10 @@
)
(if missing
(progn
(princ (strcat "\n FEHLER: DXFM_BLOCKS = " block-pfad))
(princ "\n Folgende Block-Dateien fehlen:")
(princ (ssg-textf "vfs-block-fehler-pfad" (list block-pfad)))
(princ (ssg-text "vfs-block-fehlende-header"))
(foreach f (reverse missing)
(princ (strcat "\n - " f))
(princ (ssg-textf "vfs-block-fehlende-item" (list f)))
)
nil
)
@@ -101,7 +101,7 @@
(if (and *lib-initialized* bogen-auf bogen-ab
(tblsearch "BLOCK" "AS_Element_90_links"))
(progn
(princ "\n Standard-Bibliothek bereits initialisiert.")
(princ (ssg-text "vfs-lib-bereits-init"))
t
)
(if (not (vf-check-required-blocks))
@@ -109,10 +109,10 @@
(progn
(setq *lib-initialized* nil)
(setq *ks-cache* nil)
(princ "\n Initialisiere Standard-Bibliothek...")
(princ (ssg-text "vfs-lib-init-start"))
;; AS_90 Masse extrahieren
(princ "\n Extrahiere AUS_Element Masse...")
(princ (ssg-text "vfs-extrahiere-aus"))
(ensure-block-loaded "AS_Element_90_links")
(ensure-block-loaded "AS_Element_90_rechts")
(if (tblsearch "BLOCK" "AS_Element_90_links")
@@ -132,17 +132,16 @@
(setq aus-dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
(setq aus-dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos))))
(setq aus-dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
(princ (strcat "\n AS_90: dx=" (rtos aus-dx 2 0)
" dz=" (rtos aus-dz 2 0)))
(princ (ssg-textf "vfs-as90-mass" (list (rtos aus-dx 2 0) (rtos aus-dz 2 0))))
)
(princ "\n FEHLER: KS_EIN/KS_AUS fehlt im AS_90!")
(princ (ssg-text "vfs-fehler-ks-as90"))
)
)
(princ "\n FEHLER: Block AS_Element_90_links nicht geladen!")
(princ (ssg-text "vfs-fehler-block-as90"))
)
;; ES_90 Masse extrahieren
(princ "\n Extrahiere EIN_Element Masse...")
(princ (ssg-text "vfs-extrahiere-ein"))
(ensure-block-loaded "ES_Element_90_links")
(ensure-block-loaded "ES_Element_90_rechts")
(if (tblsearch "BLOCK" "ES_Element_90_links")
@@ -162,17 +161,16 @@
(setq ein-dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
(setq ein-dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos))))
(setq ein-dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
(princ (strcat "\n ES_90: dx=" (rtos ein-dx 2 0)
" dz=" (rtos ein-dz 2 0)))
(princ (ssg-textf "vfs-es90-mass" (list (rtos ein-dx 2 0) (rtos ein-dz 2 0))))
)
(princ "\n FEHLER: KS_EIN/KS_AUS fehlt im ES_90!")
(princ (ssg-text "vfs-fehler-ks-es90"))
)
)
(princ "\n FEHLER: Block ES_Element_90_links nicht geladen!")
(princ (ssg-text "vfs-fehler-block-es90"))
)
;; Bogen-Masse extrahieren
(princ "\n Extrahiere Bogen-Masse...")
(princ (ssg-text "vfs-extrahiere-bogen"))
(setq bogen-auf '())
(setq bogen-ab '())
(setq bogen-winkel (ssg-cfg-or "vario" "bogen_winkel"
@@ -198,13 +196,12 @@
(setq dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos))))
(setq dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
(setq bogen-auf (cons (list w dx dy dz) bogen-auf))
(princ (strcat "\n OK auf_" (itoa w)
": dx=" (rtos dx 2 0) " dz=" (rtos dz 2 0)))
(princ (ssg-textf "vfs-bogen-auf-ok" (list (itoa w) (rtos dx 2 0) (rtos dz 2 0))))
)
(princ (strcat "\n FEHLER auf_" (itoa w) ": KS fehlt!"))
(princ (ssg-textf "vfs-bogen-auf-ks-fehlt" (list (itoa w))))
)
)
(princ (strcat "\n FEHLER auf_" (itoa w) ": Block nicht geladen!"))
(princ (ssg-textf "vfs-bogen-auf-block-fehlt" (list (itoa w))))
)
;; Abwaertsbogen
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa w)))
@@ -226,19 +223,18 @@
(setq dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos))))
(setq dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
(setq bogen-ab (cons (list w dx dy dz) bogen-ab))
(princ (strcat "\n OK ab_" (itoa w)
": dx=" (rtos dx 2 0) " dz=" (rtos dz 2 0)))
(princ (ssg-textf "vfs-bogen-ab-ok" (list (itoa w) (rtos dx 2 0) (rtos dz 2 0))))
)
(princ (strcat "\n FEHLER ab_" (itoa w) ": KS fehlt!"))
(princ (ssg-textf "vfs-bogen-ab-ks-fehlt" (list (itoa w))))
)
)
(princ (strcat "\n FEHLER ab_" (itoa w) ": Block nicht geladen!"))
(princ (ssg-textf "vfs-bogen-ab-block-fehlt" (list (itoa w))))
)
)
(setq bogen-auf (reverse bogen-auf))
(setq bogen-ab (reverse bogen-ab))
(setq *lib-initialized* t)
(princ "\n Standard-Bibliothek erfolgreich initialisiert.")
(princ (ssg-text "vfs-lib-init-erfolg"))
t
) ;; end progn (Initialisierung)
) ;; end (if not vf-check-required-blocks)
@@ -254,8 +250,7 @@
(if (= (car item) winkel) (setq result (cdr item)))
)
(if (null result)
(princ (strcat "\n FEHLER: Winkel " (itoa winkel)
" nicht in Bogen-Tabelle!"))
(princ (ssg-textf "vfs-fehler-winkel-tabelle" (list (itoa winkel))))
)
result
)
@@ -276,7 +271,7 @@
(if (or (not *lib-initialized*) (null aus-dz) (null ein-dz))
(progn
(princ "\n FEHLER: Bibliothek nicht korrekt initialisiert (AUS/EIN-Masse fehlen)!")
(princ (ssg-text "vfs-fehler-lib-nicht-init"))
(exit)
)
)
@@ -290,11 +285,10 @@
sin3 (sin (* (ssg-cfg-or "vario" "gefaelle_winkel" 3) (/ pi 180.0))))
(princ "\n\n=========================================")
(princ "\n BERECHNUNG FUER ALLE WINKEL (Standard)")
(princ (ssg-text "vfs-berechnung-header"))
(princ "\n=========================================")
(princ (strcat "\n△L=" (rtos deltaL 2 2) " mm"
" △H=" (rtos deltaH 2 2) " mm"
" Richtung=" richtung))
(princ (ssg-textf "vfs-berechnung-parameter"
(list (rtos deltaL 2 2) (rtos deltaH 2 2) richtung)))
(foreach winkel winkel-list
(if (= richtung "Auf")
@@ -357,9 +351,9 @@
(setq ergebnis-liste (reverse ergebnis-liste))
(princ "\n\n=================================================================================")
(princ "\n ERGEBNISTABELLE")
(princ (ssg-text "vfs-ergebnistabelle-header"))
(princ "\n=================================================================================")
(princ "\n Winkel L_GF (mm) L_VF (mm) Status")
(princ (ssg-text "vfs-tabelle-spalten"))
(princ "\n=================================================================================")
(setq best-winkel nil best-L_GF nil best-L_VF nil)
@@ -367,26 +361,25 @@
(setq winkel (car item) L_GF (cadr item) L_VF (caddr item) gueltig (cadddr item))
(if (and (numberp L_GF) (numberp L_VF))
(progn
(princ (strcat "\n " (itoa winkel) (chr 176)
" " (fmt L_GF) " mm " (fmt L_VF) " mm "))
(princ (ssg-textf "vfs-tabelle-zeile"
(list (itoa winkel) (chr 176) (fmt L_GF) (fmt L_VF))))
(if gueltig
(progn
(princ "GUELTIG")
(princ (ssg-text "vfs-status-gueltig"))
(if (or (null best-winkel) (< winkel best-winkel))
(setq best-winkel winkel best-L_GF L_GF best-L_VF L_VF)
)
)
(princ "UNGUELTIG (negative Laenge)")
(princ (ssg-text "vfs-status-ungueltig"))
)
)
(princ (strcat "\n " (itoa winkel) (chr 176)
" --- --- FEHLER"))
(princ (ssg-textf "vfs-tabelle-zeile-fehler" (list (itoa winkel) (chr 176))))
)
)
(princ "\n=================================================================================")
(if best-winkel
(princ (strcat "\n>>> Empfohlener Winkel: " (itoa best-winkel) (chr 176)))
(princ "\n>>> KEIN passender Winkel gefunden!")
(princ (ssg-textf "vfs-empfohlener-winkel" (list (itoa best-winkel) (chr 176))))
(princ (ssg-text "vfs-kein-winkel-gefunden"))
)
(list best-winkel best-L_GF best-L_VF ergebnis-liste)
)
@@ -471,7 +464,7 @@
(setq hz (float hz))
(setq as-block (strcat "AS_Element_90_" seite))
(if (not *lib-initialized*) (init-bibliothek))
(princ (strcat "\n\n1/11: " as-block " (hz=" (rtos hz 2 1) grad-zeichen ")"))
(princ (ssg-textf "vfs-schritt-as" (list as-block (rtos hz 2 1) grad-zeichen)))
(insert-block-by-ks as-block startpunkt hz)
)
@@ -485,22 +478,22 @@
;; 1. Gefaellestrecke GF1 (verbindet AS-Neigung mit Umlenkstation)
(if (> L_GF1 0.1)
(progn
(princ (strcat "\n\n[VF-Eingang] Gefaellestrecke GF1 (3 Grad, L=" (rtos L_GF1 2 2) " mm)"))
(princ (ssg-textf "vfs-vf-eingang-gf1" (list (rtos L_GF1 2 2))))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_GF1 (ssg-cfg-or "vario" "gefaelle_winkel" 3) hz))
)
(princ "\n\n[VF-Eingang] Gefaellestrecke GF1 (uebersprungen)")
(princ (ssg-text "vfs-vf-eingang-gf1-skip"))
)
;; 2. Separator (am GF1-Ende / vor Umlenkstation)
(princ "\n[VF-Eingang] Separator (300 mm, 3 Grad geneigt)")
(princ (ssg-text "vfs-vf-eingang-separator"))
(setq aktueller-punkt
(insert-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt
(ssg-cfg-or "vario" "gefaelle_winkel" 3)
(ssg-cfg-or "vario" "separator_block_dx" 300)
(ssg-cfg-or "vario" "separator_block_dz" 0) hz))
;; 3. Umlenkstation
(princ "\n[VF-Eingang] Umlenkstation (500 mm, 3 Grad geneigt)")
(princ (ssg-text "vfs-vf-eingang-umlenk"))
(setq aktueller-punkt
(insert-rotated-block-with-ks "Vario_Umlenkstation_500mm" aktueller-punkt
(ssg-cfg-or "vario" "gefaelle_winkel" 3)
@@ -542,7 +535,7 @@
)
)
(setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass))
(princ (strcat "\n\n5/11: " bogen-name " (3 Grad geneigt)"))
(princ (ssg-textf "vfs-schritt5-bogen1" (list bogen-name)))
(setq aktueller-punkt
(insert-rotated-block-with-ks bogen-name aktueller-punkt
(ssg-cfg-or "vario" "gefaelle_winkel" 3) bogen-dx bogen-dz hz))