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

Uebersetzung aller Benutzermeldungen auf ssg-text/ssg-textf umgestellt

Browse Source 
Vollstaendiger i18n-Rollout ueber alle Feature- und Kernmodule: alle benutzersichtbaren princ/prompt/getXXX/alert-Texte laufen jetzt ueber die zentrale Sprachtabelle in ssg_lang.lsp (Deutsch/Englisch, umschaltbar via SSG_SPRACHE). 403 Tabelleneintraege, 497 Aufrufstellen in 17 Dateien.

Ausgeschlossen wie geplant: Debug-Ausgaben (dbg*), Lademeldungen, [DUMMY]-Platzhalter, [CFG]/[OMNI]-Diagnosemarker.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
Michael Stangl
2026-07-15 21:23:54 +02:00
parent 15ba546a17
commit 2eca169326
17 changed files with 2183 additions and 610 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
+26 -30
View File
@@ -129,7 +129,7 @@
(vla-Delete temp-obj)
(princ " 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)
)
)
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
+93 -83
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)))
)
)
)
@@ -357,11 +357,15 @@
(if (null boegen-liste)
(progn
(alert (strcat "Keine Boegen fuer "
(if (= (type winkel) 'INT) (itoa winkel) (rtos winkel 2 1))
" Grad"
(if profiltyp (strcat " (" profiltyp ")") "")
" 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
@@ -376,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")
@@ -427,7 +431,7 @@
(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)
)
@@ -437,7 +441,7 @@
(setq dlg-result (omni:bogen-dialog 90 nil nil "APB 110"))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ "\n[BOGEN] Abgebrochen.")
(princ (ssg-text "omni-abbruch-bogen"))
)
(princ)
)
@@ -446,7 +450,7 @@
(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)
)
@@ -455,7 +459,7 @@
(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)
)
@@ -464,7 +468,7 @@
(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)
)
@@ -473,7 +477,7 @@
(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)
)
@@ -513,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)
@@ -521,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)
@@ -543,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))
@@ -632,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)
)
)
@@ -784,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
@@ -807,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")
@@ -872,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)
@@ -932,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
)
@@ -956,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)
)
)
@@ -973,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)
)
@@ -982,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)
)
@@ -991,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)
)
@@ -1001,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)
)
@@ -1010,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)
)
@@ -1019,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)
)
@@ -1029,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)
)
@@ -1038,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)
)
@@ -1047,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)
)
@@ -1057,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)
)
@@ -1066,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)
)
@@ -1075,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)
)
@@ -1085,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)
)
@@ -1094,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)
)
@@ -1124,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)))
)
)
@@ -1132,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
@@ -1188,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)
)
@@ -1209,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
@@ -1222,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)
)
@@ -1251,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/SSG_LIB_Commands.lsp
+7 -7
View File
@@ -181,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)
)
@@ -198,7 +198,7 @@
(if (/= (cdr (assoc 0 ed)) "INSERT")
(progn
(princ "\nKein Block ausgewaehlt.")
(princ (ssg-text "cmd-kein-block-ausgewaehlt"))
(princ)
(exit)
)
@@ -209,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)
)
@@ -230,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/export.lsp
+14 -14
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)
)
@@ -206,22 +206,22 @@
(defun csv:run-export (label py-name csv-name / ss i ename fh out-pfad
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).
@@ -235,7 +235,7 @@
*export-test-override*
(getenv "DXFM_RESULTS")))
(if (not (vl-file-directory-p out-dir)) (vl-mkdir out-dir))
(princ (strcat "\n[" label "] Ausgabeordner: " out-dir))
(princ (ssg-textf "exp-output-dir" (list label out-dir)))
;; JSON-Datei zusammenbauen
(setq out-pfad (strcat out-dir "/"
@@ -243,7 +243,7 @@
(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
@@ -260,7 +260,7 @@
)
(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))
@@ -271,11 +271,11 @@
" \"" 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)))
)
)
)
@@ -399,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)
@@ -418,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
+4 -4
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)
@@ -225,7 +225,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 +460,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
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
+1600
View File
File diff suppressed because it is too large Load Diff
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/vf_core.lsp
+73 -86
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))
;; hz: horizontale Fahrtrichtung in Grad (0=Ost/+X, 90=Nord/+Y, ...),
@@ -694,20 +686,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)))
@@ -729,9 +720,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
)
)
@@ -759,20 +749,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))
@@ -828,10 +817,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
)
)
@@ -842,24 +830,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))
@@ -871,20 +859,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
@@ -892,25 +879,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)
@@ -938,7 +925,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; "
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
+96 -90
View File
@@ -124,13 +124,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)))))
@@ -275,8 +275,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))))
)
)
@@ -299,7 +298,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)
@@ -314,7 +313,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))
@@ -328,26 +327,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))
)
@@ -429,24 +430,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 +
@@ -474,9 +474,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)
)
@@ -518,11 +517,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")
@@ -537,11 +536,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")
@@ -561,7 +560,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"))
)
)
)
@@ -576,8 +575,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"))
@@ -591,12 +590,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"))
)
)
)
@@ -629,17 +626,20 @@
;; GF-Bogen (horizontale Kurve, Neigung bleibt wie im aktuellen Frame).
;; Fragt Winkel (30/60/90) und Seite interaktiv ab.
(defun vfl-insert-gf-bogen (frame / bwinkel bseite antwort blockname)
(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"))
(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*
@@ -657,21 +657,25 @@
;; extract-ks-from-block-raw normalisiert das (siehe ks-normalize-name).
(defun vfl-insert-vario-kurve (frame / kwinkel kseite kvariante antwort blockname
hz flach-frame)
(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"))
(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*
@@ -714,9 +718,10 @@
;; ES-Seite erst am Kettenende abfragen (Links/Rechts).
(defun vfl-frage-es-seite ( / antwort)
(princ "\n\nEIN-Element (ES_Element_90_*) - Seite waehlen:")
(princ "\n 1 - Links\n 2 - Rechts")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(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")))
(if (= antwort "2") "rechts" "links")
)
@@ -836,7 +841,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
)
@@ -850,10 +855,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.
@@ -863,10 +868,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")
@@ -879,25 +884,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)))
)
)
@@ -913,11 +921,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, ...).
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))