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* (if *vf-core-datei*
(load *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) (vla-Delete temp-obj)
(princ " OK") (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) (ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname)) (if (not (tblsearch "BLOCK" blockname))
(progn (progn
(princ (strcat "\n FEHLER: Block '" blockname "' fehlt")) (princ (ssg-textf "gf-fehler-block-fehlt" (list blockname)))
(exit) (exit)
) )
) )
@@ -294,11 +294,11 @@
(+ (car einfuegepunkt) (- (* chv dx-loc) (* shv dy-loc))) (+ (car einfuegepunkt) (- (* chv dx-loc) (* shv dy-loc)))
(+ (cadr einfuegepunkt) (+ (* shv dx-loc) (* chv dy-loc))) (+ (cadr einfuegepunkt) (+ (* shv dx-loc) (* chv dy-loc)))
(+ (caddr einfuegepunkt) dz-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 ausgang
) )
(progn (progn
(princ "\n WARNUNG: KS_EIN/KS_AUS fehlt!") (princ (ssg-text "gf-warnung-ks-fehlt"))
einfuegepunkt einfuegepunkt
) )
) )
@@ -310,7 +310,7 @@
(defun insert-inclined-scaled-block (blockname startpunkt laenge winkel hz / (defun insert-inclined-scaled-block (blockname startpunkt laenge winkel hz /
rad-v rad-h chv shv cvv svv scale block-obj endpunkt) rad-v rad-h chv shv cvv svv scale block-obj endpunkt)
(if (<= laenge 0.1) (if (<= laenge 0.1)
(progn (princ "\n (Laenge 0 - uebersprungen)") startpunkt) (progn (princ (ssg-text "gf-laenge-null-uebersprungen")) startpunkt)
(progn (progn
(ensure-block-loaded blockname) (ensure-block-loaded blockname)
(setq scale (/ (float laenge) 1000.0)) (setq scale (/ (float laenge) 1000.0))
@@ -333,8 +333,8 @@
(list (+ (car startpunkt) (* laenge chv cvv)) (list (+ (car startpunkt) (* laenge chv cvv))
(+ (cadr startpunkt) (* laenge shv cvv)) (+ (cadr startpunkt) (* laenge shv cvv))
(+ (caddr startpunkt) (* laenge (- svv))))) (+ (caddr startpunkt) (* laenge (- svv)))))
(princ (strcat "\n " blockname " L=" (rtos laenge 2 1) (princ (ssg-textf "gf-status-block-l-z"
" -> Z=" (rtos (caddr endpunkt) 2 1))) (list blockname (rtos laenge 2 1) (rtos (caddr endpunkt) 2 1))))
endpunkt endpunkt
) )
) )
@@ -425,7 +425,7 @@
(if (null (car (atoms-family 1 '("GET-LINE-START-END-POINTS")))) (if (null (car (atoms-family 1 '("GET-LINE-START-END-POINTS"))))
(defun get-line-start-end-points (msg / ent obj obj-name sp ep) (defun get-line-start-end-points (msg / ent obj obj-name sp ep)
(princ msg) (princ msg)
(setq ent (entsel "\n >> Linie waehlen: ")) (setq ent (entsel (ssg-text "gf-prompt-linie-waehlen")))
(if ent (if ent
(progn (progn
(setq obj (vlax-ename->vla-object (car ent))) (setq obj (vlax-ename->vla-object (car ent)))
@@ -436,11 +436,11 @@
(vlax-variant-value (vla-get-StartPoint obj)))) (vlax-variant-value (vla-get-StartPoint obj))))
(setq ep (vlax-safearray->list (setq ep (vlax-safearray->list
(vlax-variant-value (vla-get-EndPoint obj)))) (vlax-variant-value (vla-get-EndPoint obj))))
(princ (strcat "\n 3D-Linie: Z_start=" (rtos (caddr sp) 2 2) (princ (ssg-textf "gf-status-3dlinie-z"
" Z_end=" (rtos (caddr ep) 2 2))) (list (rtos (caddr sp) 2 2) (rtos (caddr ep) 2 2))))
(list sp ep) (list sp ep)
) )
(t (princ "\n Fehler: keine Linie!") nil) (t (princ (ssg-text "gf-fehler-keine-linie")) nil)
) )
) )
nil nil
@@ -525,7 +525,7 @@
(defun gf-insert-hz-incl-scaled (blockname pt laenge hz-grad vert-grad / (defun gf-insert-hz-incl-scaled (blockname pt laenge hz-grad vert-grad /
chz shz cv sv scale block-obj endpunkt) chz shz cv sv scale block-obj endpunkt)
(if (<= laenge 0.1) (if (<= laenge 0.1)
(progn (princ "\n (Laenge 0 - uebersprungen)") pt) (progn (princ (ssg-text "gf-laenge-null-uebersprungen")) pt)
(progn (progn
(ensure-block-loaded blockname) (ensure-block-loaded blockname)
(setq scale (/ (float laenge) 1000.0)) (setq scale (/ (float laenge) 1000.0))
@@ -546,11 +546,9 @@
(list (+ (car pt) (* laenge chz cv)) (list (+ (car pt) (* laenge chz cv))
(+ (cadr pt) (* laenge shz cv)) (+ (cadr pt) (* laenge shz cv))
(+ (caddr pt) (* (- sv) laenge)))) (+ (caddr pt) (* (- sv) laenge))))
(princ (strcat "\n HzIncl " blockname (princ (ssg-textf "gf-status-hzincl"
" L=" (rtos laenge 2 0) (list blockname (rtos laenge 2 0) (rtos hz-grad 2 0) grad-zeichen
" hz=" (rtos hz-grad 2 0) grad-zeichen (rtos vert-grad 2 1) grad-zeichen (rtos (caddr endpunkt) 2 1))))
" v=" (rtos vert-grad 2 1) grad-zeichen
" -> Z=" (rtos (caddr endpunkt) 2 1)))
endpunkt endpunkt
) )
) )
@@ -579,10 +577,9 @@
(list (+ (car pt) (+ (* dx chz cv) (* dz chz sv))) (list (+ (car pt) (+ (* dx chz cv) (* dz chz sv)))
(+ (cadr pt) (+ (* dx shz cv) (* dz shz sv))) (+ (cadr pt) (+ (* dx shz cv) (* dz shz sv)))
(+ (caddr pt) (+ (* (- sv) dx) (* cv dz))))) (+ (caddr pt) (+ (* (- sv) dx) (* cv dz)))))
(princ (strcat "\n HzKS " blockname (princ (ssg-textf "gf-status-hzks"
" hz=" (rtos hz-grad 2 0) grad-zeichen (list blockname (rtos hz-grad 2 0) grad-zeichen
" v=" (rtos vert-grad 2 1) grad-zeichen (rtos vert-grad 2 1) grad-zeichen (rtos (caddr endpunkt) 2 1))))
" -> Z=" (rtos (caddr endpunkt) 2 1)))
endpunkt endpunkt
) )
@@ -597,7 +594,7 @@
(ensure-block-loaded blockname) (ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname)) (if (not (tblsearch "BLOCK" blockname))
(progn (progn
(princ (strcat "\n FEHLER: Block '" blockname "' fehlt!")) (princ (ssg-textf "gf-fehler-block-fehlt-ausruf" (list blockname)))
(exit) (exit)
) )
) )
@@ -643,13 +640,12 @@
(list (+ (car p-aus-rot) (car offset)) (list (+ (car p-aus-rot) (car offset))
(+ (cadr p-aus-rot) (cadr offset)) (+ (cadr p-aus-rot) (cadr offset))
(+ (caddr p-aus-rot) (caddr offset)))) (+ (caddr p-aus-rot) (caddr offset))))
(princ (strcat "\n Gefaellebogen " blockname (princ (ssg-textf "gf-status-gefaellebogen"
" hz=" (rtos hz-grad 2 0) grad-zeichen (list blockname (rtos hz-grad 2 0) grad-zeichen (rtos (caddr ausgang) 2 1))))
" -> Z=" (rtos (caddr ausgang) 2 1)))
ausgang ausgang
) )
(progn (progn
(princ (strcat "\n WARNUNG: KS fehlt in '" blockname "'")) (princ (ssg-textf "gf-warnung-ks-fehlt-in" (list blockname)))
pt pt
) )
) )
@@ -689,7 +685,7 @@
(ensure-block-loaded blockname) (ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname)) (if (not (tblsearch "BLOCK" blockname))
(progn (progn
(princ (strcat "\n WARNUNG: " blockname " fehlt - Nullwerte")) (princ (ssg-textf "gf-warnung-block-fehlt-nullwerte" (list blockname)))
'(0 0) '(0 0)
) )
(progn (progn
@@ -707,12 +703,12 @@
(progn (progn
(setq dx (- (caar ks-aus-pos) (caar ks-ein-pos))) (setq dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
(setq dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos)))) (setq dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
(princ (strcat "\n " blockname (princ (ssg-textf "gf-status-bogen-masse"
": dx=" (rtos dx 2 1) " dz=" (rtos dz 2 1))) (list blockname (rtos dx 2 1) (rtos dz 2 1))))
(list dx dz) (list dx dz)
) )
(progn (progn
(princ (strcat "\n WARNUNG: KS fehlt in " blockname)) (princ (ssg-textf "gf-warnung-ks-fehlt-in2" (list blockname)))
'(0 0) '(0 0)
) )
) )
Lisp/KreiselInsert.lsp
+96 -105
View File
@@ -31,7 +31,7 @@
(strcat (substr *ssg-lisp-pfad* 1 (vl-string-search "/Lisp" *ssg-lisp-pfad*)) (strcat (substr *ssg-lisp-pfad* 1 (vl-string-search "/Lisp" *ssg-lisp-pfad*))
"/data/ils/" *ki-dxfm-dim* "/")) "/data/ils/" *ki-dxfm-dim* "/"))
(t (t
(princ "\n[KreiselInsert] WARNUNG: Block-Pfad nicht ermittelbar!") (princ (ssg-text "kreisel-warn-blockpfad"))
nil) nil)
) )
) )
@@ -58,7 +58,7 @@
(defun ssg-cfg-or (sektion schluessel standard) standard) (defun ssg-cfg-or (sektion schluessel standard) standard)
(defun ssg-cfg (sektion schluessel) nil) (defun ssg-cfg (sektion schluessel) nil)
(defun ssg-load-config () 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 (progn
;; Neuen Textstil mit Arial erstellen ;; Neuen Textstil mit Arial erstellen
(command "_.STYLE" style-name "Arial" 0 1 0 "N" "N" "N") (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 (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 textStr
) )
@@ -230,9 +230,9 @@
;; Kreiselart abfragen. Rueckgabe: "PIN" oder "STANDARD" ;; Kreiselart abfragen. Rueckgabe: "PIN" oder "STANDARD"
(defun kreisel-ask-typ ( / typNum typ) (defun kreisel-ask-typ ( / typNum typ)
(princ "\n[1] STANDARD (ohne PIN)") (princ (ssg-text "kreisel-typ-opt-standard"))
(princ "\n[2] PIN") (princ (ssg-text "kreisel-typ-opt-pin"))
(princ (strcat "\nBitte waehlen <" (if (= #Kreisel_Typ "PIN") "2" "1") ">: ")) (princ (ssg-textf "kreisel-typ-prompt" (list (if (= #Kreisel_Typ "PIN") "2" "1"))))
(setq typNum (getstring "")) (setq typNum (getstring ""))
(cond (cond
((= typNum "2") (setq typ "PIN")) ((= typNum "2") (setq typ "PIN"))
@@ -337,7 +337,7 @@
(progn (progn
(setq z-hoehe (caddr basePoint)) (setq z-hoehe (caddr basePoint))
(setq block-hoehe (rtos z-hoehe 2 0)) (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 (progn
;; Höhe aus Attributen lesen ;; Höhe aus Attributen lesen
@@ -454,12 +454,12 @@
;; --- Block erzeugen (Entities werden aus Zeichnung entfernt) --- ;; --- Block erzeugen (Entities werden aus Zeichnung entfernt) ---
(if (> (sslength ss) 0) (if (> (sslength ss) 0)
(command "_.-BLOCK" bname (list 0.0 0.0 0.0) ss "") (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) --- ;; --- Block am Zielpunkt einfuegen (ohne Attribut-Dialog) ---
@@ -495,8 +495,7 @@
(if (atoms-family 1 '("ssg-id-generate")) (if (atoms-family 1 '("ssg-id-generate"))
(ssg-id-generate block-ent) (ssg-id-generate block-ent)
) )
(princ (strcat "\n-> Kreisel #" (itoa kreisel-nummer) " eingefügt: " bname (princ (ssg-textf "kreisel-eingefuegt" (list (itoa kreisel-nummer) bname block-hoehe)))
" (Höhe=" block-hoehe ")"))
(entlast) (entlast)
) )
@@ -514,19 +513,19 @@
;; -------------------------------------------- ;; --------------------------------------------
(defun c:KreiselInsert ( / pt abstand typ rotation rotStr hoehe (defun c:KreiselInsert ( / pt abstand typ rotation rotStr hoehe
selectedEnt blockAttribs oldOsmode) 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 ;; Temporär Osnap für Blockerkennung setzen
(setq oldOsmode (getvar "OSMODE")) (setq oldOsmode (getvar "OSMODE"))
(setvar "OSMODE" (logior oldOsmode 512)) ;; 512 = INS (Block-Einfügepunkt) (setvar "OSMODE" (logior oldOsmode 512)) ;; 512 = INS (Block-Einfügepunkt)
;; 1. Einfuegepunkt ;; 1. Einfuegepunkt
(setq pt (getpoint "\nBasispunkt (AN-Seite): ")) (setq pt (getpoint (ssg-text "kreisel-prompt-basispunkt")))
(if (null pt) (if (null pt)
(progn (progn
(setvar "OSMODE" oldOsmode) (setvar "OSMODE" oldOsmode)
(ssg-end) (ssg-end)
(princ "\nBefehl abgebrochen.") (princ (ssg-text "kreisel-abbruch-befehl"))
(princ) (princ)
(return) (return)
) )
@@ -546,16 +545,16 @@
(setq blockAttribs (ssg-attrib-read selectedEnt)) (setq blockAttribs (ssg-attrib-read selectedEnt))
(assoc "HOEHE" blockAttribs)) (assoc "HOEHE" blockAttribs))
(setq hoehe (atof (cdr (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 ;; Fall 2: Punkt hat Z-Koordinate > 0
((and (> (length pt) 2) (> (caddr pt) 0)) ((and (> (length pt) 2) (> (caddr pt) 0))
(setq hoehe (caddr pt)) (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 ;; Fall 3: Sonst separat abfragen
(t (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*)) (if (null hoehe) (setq hoehe *kreisel-default-hoehe*))
) )
) )
@@ -563,13 +562,12 @@
;; 3. Abstand ;; 3. Abstand
(initget 6) (initget 6)
(setq abstand (getdist (list (car pt) (cadr pt)) (setq abstand (getdist (list (car pt) (cadr pt))
(strcat "\nAbstand (Tangentenlaenge) <" (ssg-textf "kreisel-prompt-abstand" (list (rtos *kreisel-default-laenge* 2 0)))))
(rtos *kreisel-default-laenge* 2 0) ">: ")))
(if (null abstand) (setq abstand *kreisel-default-laenge*)) (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 ;; 4. Rotation
(setq rotStr (getstring "\nRotation in Grad <0>: ")) (setq rotStr (getstring (ssg-text "kreisel-prompt-rotation")))
(if (= rotStr "") (if (= rotStr "")
(setq rotation 0.0) (setq rotation 0.0)
(setq rotation (atof rotStr)) (setq rotation (atof rotStr))
@@ -578,9 +576,8 @@
;; 5. Kreiselart ;; 5. Kreiselart
(setq typ (kreisel-ask-typ)) (setq typ (kreisel-ask-typ))
(princ (strcat "\n-> Rotation: " (rtos rotation 2 1) (princ (ssg-textf "kreisel-insert-zusammenfassung"
" Höhe: " (rtos hoehe 2 0) (list (rtos rotation 2 1) (rtos hoehe 2 0) typ)))
" Kreiselart: " typ))
;; 6. Modul einfuegen ;; 6. Modul einfuegen
(draw-module (list (car pt) (cadr pt) hoehe) abstand rotation (draw-module (list (car pt) (cadr pt) hoehe) abstand rotation
@@ -590,7 +587,7 @@
;; KEIN weiteres (setvar "OSMODE" ...) mehr nötig! ;; KEIN weiteres (setvar "OSMODE" ...) mehr nötig!
;; ssg-end stellt nur CLAYER und CMDECHO wieder her, nicht OSMODE ;; ssg-end stellt nur CLAYER und CMDECHO wieder her, nicht OSMODE
(princ "\nKreisel Modul eingefuegt.") (princ (ssg-text "kreisel-insert-fertig"))
(ssg-end) (ssg-end)
) )
@@ -607,20 +604,20 @@
;; ----------------------------------------------- ;; -----------------------------------------------
(defun c:KreiselConnect ( / ptStart ptEnd dx dy dist abstand rotation typ hoehe) (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) ;; 1. Startpunkt (aeusserster Punkt AN-Seite)
(setq ptStart (getpoint "\nStartpunkt (AN-Seite aussen): ")) (setq ptStart (getpoint (ssg-text "kreisel-prompt-startpunkt")))
(if (null ptStart) (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 ;; 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) (if (null ptEnd)
(progn (ssg-end) (princ "\nAbgebrochen.") (princ) (exit)) (progn (ssg-end) (princ (ssg-text "kreisel-abgebrochen")) (princ) (exit))
) )
;; 3. Geometrie berechnen ;; 3. Geometrie berechnen
@@ -631,8 +628,8 @@
(if (<= abstand 0.0) (if (<= abstand 0.0)
(progn (progn
(ssg-emsg (strcat "Distanz zu klein! (" (ssg-emsg (ssg-textf "kreisel-emsg-distanz-klein"
(rtos dist 2 0) " < " (rtos *kreisel-durchmesser* 2 0) ")")) (list (rtos dist 2 0) (rtos *kreisel-durchmesser* 2 0))))
(ssg-end) (ssg-end)
(exit) (exit)
) )
@@ -648,26 +645,24 @@
) )
(if (<= hoehe 0.0) (if (<= hoehe 0.0)
(progn (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*)) (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 ;; 6. Kreiselart abfragen
(setq typ (kreisel-ask-typ)) (setq typ (kreisel-ask-typ))
(princ (strcat "\n-> Abstand: " (rtos abstand 2 0) " mm" (princ (ssg-textf "kreisel-connect-zusammenfassung"
" Rotation: " (rtos rotation 2 1) " Grad" (list (rtos abstand 2 0) (rtos rotation 2 1) (rtos hoehe 2 0) typ)))
" Hoehe: " (rtos hoehe 2 0)
" Kreiselart: " typ))
;; 7. Modul einfuegen ;; 7. Modul einfuegen
(draw-module (list (car ptStart) (cadr ptStart) hoehe) abstand rotation (draw-module (list (car ptStart) (cadr ptStart) hoehe) abstand rotation
(list (cons "KREISELART" typ) (list (cons "KREISELART" typ)
(cons "HOEHE" (rtos hoehe 2 0)))) (cons "HOEHE" (rtos hoehe 2 0))))
(princ "\nKreisel Connect erfolgreich!") (princ (ssg-text "kreisel-connect-erfolgreich"))
(ssg-end) (ssg-end)
) )
@@ -684,7 +679,7 @@
;; hoehe : Hoehe in mm (oder nil fuer Z aus pt) ;; hoehe : Hoehe in mm (oder nil fuer Z aus pt)
;; Rueckgabe: Entity-Name des erzeugten Blocks oder nil ;; Rueckgabe: Entity-Name des erzeugten Blocks oder nil
(defun kreisel-insert-script (pt abstand rotation typ hoehe / z blockEnt) (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")) (if (null typ) (setq typ "STANDARD"))
(setq z (if hoehe hoehe (setq z (if hoehe hoehe
(if (and pt (caddr pt)) (caddr pt) *kreisel-default-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) ;; hoehe : Hoehe in mm (oder nil fuer Z aus ptStart)
;; Rueckgabe: Entity-Name des erzeugten Blocks oder nil ;; Rueckgabe: Entity-Name des erzeugten Blocks oder nil
(defun kreisel-connect-script (ptStart ptEnd typ hoehe / dx dy dist abstand rotation z blockEnt) (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")) (if (null typ) (setq typ "STANDARD"))
(setq dx (- (car ptEnd) (car ptStart)) (setq dx (- (car ptEnd) (car ptStart))
dy (- (cadr ptEnd) (cadr ptStart))) dy (- (cadr ptEnd) (cadr ptStart)))
(setq dist (sqrt (+ (* dx dx) (* dy dy)))) (setq dist (sqrt (+ (* dx dx) (* dy dy))))
(setq abstand (- dist *kreisel-durchmesser*)) (setq abstand (- dist *kreisel-durchmesser*))
(if (<= abstand 0.0) (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) (ssg-end) nil)
(progn (progn
(setq rotation (* (/ 180.0 pi) (atan dy dx))) (setq rotation (* (/ 180.0 pi) (atan dy dx)))
@@ -727,19 +722,19 @@
;; Neue Befehle für Beschriftungs-Einstellungen ;; Neue Befehle für Beschriftungs-Einstellungen
(defun c:KreiselLabelPos ( / dx dy) (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)) (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)) (if dy (setq *kreisel-beschriftung-abstand-y* dy))
(princ (strcat "\nNeue Beschriftungsposition: X=" (rtos *kreisel-beschriftung-abstand-x* 2 0) (princ (ssg-textf "kreisel-neue-beschriftungsposition"
" Y=" (rtos *kreisel-beschriftung-abstand-y* 2 0))) (list (rtos *kreisel-beschriftung-abstand-x* 2 0) (rtos *kreisel-beschriftung-abstand-y* 2 0))))
(princ) (princ)
) )
(defun c:KreiselLabelHoehe ( / h) (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)) (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) (princ)
) )
@@ -753,17 +748,17 @@
;; ----------------------------------------------- ;; -----------------------------------------------
(defun c:KreiselRedraw ( / sel ent ed attribs basePoint rotation newAbstand) (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 ;; 1. Bestehenden Kreisel-Block auswaehlen
(setq sel (entsel "\nKreisel-Block auswaehlen: ")) (setq sel (entsel (ssg-text "kreisel-prompt-block-auswaehlen")))
(if (null sel) (exit)) (if (null sel) (exit))
(setq ent (car sel)) (setq ent (car sel))
(setq ed (entget ent)) (setq ed (entget ent))
;; Pruefen ob INSERT ;; Pruefen ob INSERT
(if (/= (cdr (assoc 0 ed)) "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 ;; 2. Bestehende Werte auslesen
@@ -772,19 +767,20 @@
(setq rotation (* (/ 180.0 pi) (cdr (assoc 50 ed)))) (setq rotation (* (/ 180.0 pi) (cdr (assoc 50 ed))))
;; NEU - Höhe aus Attributen lesen und anzeigen: ;; NEU - Höhe aus Attributen lesen und anzeigen:
(princ (strcat "\n-> Bestehend: Abstand=" (cdr (assoc "ABSTAND" attribs)) (princ (ssg-textf "kreisel-redraw-bestehend"
" Drehung=" (cdr (assoc "DREHUNG" attribs)) (list (cdr (assoc "ABSTAND" attribs))
" Höhe=" (cdr (assoc "HOEHE" attribs)) ;; <-- NEU (cdr (assoc "DREHUNG" attribs))
" Art=" (cdr (assoc "KREISELART" attribs)))) (cdr (assoc "HOEHE" attribs))
(cdr (assoc "KREISELART" attribs)))))
;; 3. Neuen Abstand abfragen (Enter = beibehalten) ;; 3. Neuen Abstand abfragen (Enter = beibehalten)
(initget 6) (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) (if (null newAbstand)
(setq newAbstand (atof (cdr (assoc "ABSTAND" attribs)))) (setq newAbstand (atof (cdr (assoc "ABSTAND" attribs))))
) )
;; NEU - Neue Höhe abfragen: ;; 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) (if (null newHoehe)
(setq newHoehe (atof (cdr (assoc "HOEHE" attribs)))) (setq newHoehe (atof (cdr (assoc "HOEHE" attribs))))
) )
@@ -795,7 +791,7 @@
(draw-module (list (car basePoint) (cadr basePoint) newHoehe) (draw-module (list (car basePoint) (cadr basePoint) newHoehe)
newAbstand rotation attribs) 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) (ssg-end)
) )
@@ -804,17 +800,17 @@
;; KreiselQuick: Schnell mit Defaults (horizontal) ;; KreiselQuick: Schnell mit Defaults (horizontal)
;; -------------------------------------------- ;; --------------------------------------------
(defun c:KreiselQuick ( / pt) (defun c:KreiselQuick ( / pt)
(ssg-start "Kreisel Schnell Einfuegen" '(("CECOLOR"))) (ssg-start (ssg-text "kreisel-start-quick") '(("CECOLOR")))
(setq pt (getpoint "\nBasispunkt (AN-Seite): ")) (setq pt (getpoint (ssg-text "kreisel-prompt-basispunkt")))
;; NEU - Höhe abfragen: ;; 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 (null hoehe) (setq hoehe 0.0))
(if pt (if pt
;; NEU - Höhe im Aufruf übergeben: ;; 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)))) (list (cons "HOEHE" (rtos hoehe 2 0))))
) )
(princ "\nSchnell Einfuegen fertig.") (princ (ssg-text "kreisel-quick-fertig"))
(ssg-end) (ssg-end)
) )
@@ -870,13 +866,13 @@
(setq ent (ssname ss 0)) (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) (setvar "OSMODE" 0)
;; 1. Block auswaehlen (falls nicht vorselektiert) ;; 1. Block auswaehlen (falls nicht vorselektiert)
(if (null ent) (if (null ent)
(progn (progn
(setq sel (entsel "\nKreisel-Block auswaehlen: ")) (setq sel (entsel (ssg-text "kreisel-prompt-block-auswaehlen")))
(if sel (setq ent (car sel))) (if sel (setq ent (car sel)))
) )
) )
@@ -884,7 +880,7 @@
(setq ed (entget ent)) (setq ed (entget ent))
(if (/= (cdr (assoc 0 ed)) "INSERT") (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 ;; 2. Bestehende Werte auslesen
@@ -895,7 +891,7 @@
;; Pruefen ob Block Kreisel-Attribute hat (mindestens ABSTAND) ;; Pruefen ob Block Kreisel-Attribute hat (mindestens ABSTAND)
(if (null (assoc "ABSTAND" attribs)) (if (null (assoc "ABSTAND" attribs))
(progn (progn
(ssg-emsg "Kein Kreisel-Block! (Attribut ABSTAND fehlt)") (ssg-emsg (ssg-text "kreisel-emsg-kein-kreisel-block"))
(ssg-end) (ssg-end)
(exit) (exit)
) )
@@ -912,15 +908,14 @@
(setq attribs (subst (cons "HOEHE" (rtos (if (caddr basePoint) (caddr basePoint) 0.0) 2 1)) (setq attribs (subst (cons "HOEHE" (rtos (if (caddr basePoint) (caddr basePoint) 0.0) 2 1))
(assoc "HOEHE" attribs) attribs)) (assoc "HOEHE" attribs) attribs))
(princ (strcat "\n-> Bestehend: Abstand=" (cdr (assoc "ABSTAND" attribs)) (princ (ssg-textf "kreisel-edit-bestehend"
" Drehung=" (rtos rotation 2 1) (list (cdr (assoc "ABSTAND" attribs)) (rtos rotation 2 1) (cdr (assoc "KREISELART" attribs)))))
" Art=" (cdr (assoc "KREISELART" attribs))))
;; 3. DCL-Dialog laden ;; 3. DCL-Dialog laden
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/kreisel_edit.dcl")) (setq dcl-pfad (strcat (getenv "DXFM_DCL") "/kreisel_edit.dcl"))
(setq dat (load_dialog dcl-pfad)) (setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "kreisel_edit" dat)) (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 ;; Ausrichtungs-Labels fuer popup_list aufbauen
@@ -999,13 +994,10 @@
(draw-module (list (car basePoint) (cadr basePoint) (atof dlg-hoehe)) (draw-module (list (car basePoint) (cadr basePoint) (atof dlg-hoehe))
newAbstand newRotation attribs) newAbstand newRotation attribs)
(princ (strcat "\nKreisel aktualisiert: " (princ (ssg-textf "kreisel-edit-aktualisiert"
"Name=" dlg-name (list dlg-name (rtos newAbstand 2 0) dlg-hoehe (rtos newRotation 2 1))))
" Abstand=" (rtos newAbstand 2 0)
" Hoehe=" dlg-hoehe
" Rotation=" (rtos newRotation 2 1)))
) )
(princ "\nAbgebrochen.") (princ (ssg-text "kreisel-abgebrochen"))
) )
(ssg-end) (ssg-end)
@@ -1016,13 +1008,13 @@
;; KreiselParams: Aktuelle Parameter anzeigen ;; KreiselParams: Aktuelle Parameter anzeigen
;; -------------------------------------------- ;; --------------------------------------------
(defun c:KreiselParams () (defun c:KreiselParams ()
(princ "\n=== Kreisel Parameter ===") (princ (ssg-text "kreisel-params-header"))
(princ (strcat "\nKreiselart: " #Kreisel_Typ)) (princ (ssg-textf "kreisel-params-typ" (list #Kreisel_Typ)))
(princ (strcat "\nDurchmesser: " (rtos *kreisel-durchmesser* 2 0))) (princ (ssg-textf "kreisel-params-durchmesser" (list (rtos *kreisel-durchmesser* 2 0))))
(princ (strcat "\nDefault-Laenge: " (rtos *kreisel-default-laenge* 2 0))) (princ (ssg-textf "kreisel-params-default-laenge" (list (rtos *kreisel-default-laenge* 2 0))))
;; NEU - Default-Höhe anzeigen: ;; NEU - Default-Höhe anzeigen:
(princ (strcat "\nDefault-Höhe: " (rtos *kreisel-default-hoehe* 2 0))) (princ (ssg-textf "kreisel-params-default-hoehe" (list (rtos *kreisel-default-hoehe* 2 0))))
(princ "\nAttribute im Block:") (princ (ssg-text "kreisel-params-attribute-header"))
(foreach def *kreisel-attrib-defs* (foreach def *kreisel-attrib-defs*
(princ (strcat "\n " (car def) " = " (cadr def))) (princ (strcat "\n " (car def) " = " (cadr def)))
) )
@@ -1045,12 +1037,12 @@
(dbgf "c:ILS_Eckrad") (dbgf "c:ILS_Eckrad")
;; 1. Beruehrpunkt (Tangentenpunkt) ;; 1. Beruehrpunkt (Tangentenpunkt)
(setq ptTangent (getpoint "\nBeruehrpunkt Eckrad (Tangente): ")) (setq ptTangent (getpoint (ssg-text "kreisel-eckrad-beruehrpunkt")))
(if (null ptTangent) (progn (dbgreturn nil) (exit))) (if (null ptTangent) (progn (dbgreturn nil) (exit)))
(dbg 'ptTangent) (dbg 'ptTangent)
;; 2. Richtungspunkt (Gummiband vom Beruehrpunkt) ;; 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))) (if (null ptDir) (progn (dbgreturn nil) (exit)))
(dbg 'ptDir) (dbg 'ptDir)
@@ -1061,7 +1053,7 @@
(if (<= dist (ssg-cfg-or "kreisel" "toleranz_min_distanz" 0.001)) (if (<= dist (ssg-cfg-or "kreisel" "toleranz_min_distanz" 0.001))
(progn (progn
(princ "\nFehler: Beruehr- und Richtungspunkt sind identisch!") (princ (ssg-text "kreisel-eckrad-fehler-identisch"))
(dbgreturn nil) (dbgreturn nil)
(exit) (exit)
) )
@@ -1087,10 +1079,10 @@
(if (and (> (length ptTangent) 2) (caddr ptTangent) (> (caddr ptTangent) 0)) (if (and (> (length ptTangent) 2) (caddr ptTangent) (> (caddr ptTangent) 0))
(progn (progn
(setq hoehe (caddr ptTangent)) (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 (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*)) (if (null hoehe) (setq hoehe *eckrad-default-hoehe*))
) )
) )
@@ -1118,7 +1110,7 @@
(dbg 'pt) (dbg 'pt)
(dbg 'rotation) (dbg 'rotation)
(ssg-start "Eckrad einfuegen" '(("ATTREQ") ("ATTDIA") ("OSMODE") ("CECOLOR"))) (ssg-start (ssg-text "kreisel-start-eckrad") '(("ATTREQ") ("ATTDIA") ("OSMODE") ("CECOLOR")))
;; Attribute vorbereiten ;; Attribute vorbereiten
(setq attribs (ssg-attrib-merge attribs *eckrad-attrib-defs*)) (setq attribs (ssg-attrib-merge attribs *eckrad-attrib-defs*))
@@ -1215,14 +1207,14 @@
(dbgp (strcat "Blockdefinition erzeugt: " bname)) (dbgp (strcat "Blockdefinition erzeugt: " bname))
) )
(progn (progn
(princ "\nFehler: Keine Entities zum Block erstellen!") (princ (ssg-text "kreisel-fehler-keine-entities"))
(dbgp "FEHLER: Keine Entities fuer Block!") (dbgp "FEHLER: Keine Entities fuer Block!")
) )
) )
(princ (strcat "\n-> Neue Blockdefinition: " bname)) (princ (ssg-textf "kreisel-neue-blockdef" (list bname)))
) )
(progn (progn
(princ (strcat "\n-> Verwende bestehende Blockdefinition: " bname)) (princ (ssg-textf "kreisel-bestehende-blockdef" (list bname)))
(dbgp (strcat "Verwende bestehende Blockdefinition: " bname)) (dbgp (strcat "Verwende bestehende Blockdefinition: " bname))
) )
) )
@@ -1259,29 +1251,28 @@
) )
(entupd block-ent) (entupd block-ent)
(princ (strcat "\n-> Eckrad #" (itoa eckrad-nummer) " eingefuegt: " bname (princ (ssg-textf "kreisel-eckrad-eingefuegt"
" bei " (rtos (car pt) 2 1) "," (rtos (cadr pt) 2 1) (list (itoa eckrad-nummer) bname (rtos (car pt) 2 1) (rtos (cadr pt) 2 1)
" Rotation=" (rtos rotation 2 1) (rtos rotation 2 1) block-hoehe)))
" Hoehe=" block-hoehe))
(ssg-end) (ssg-end)
(dbgreturn (entlast)) (dbgreturn (entlast))
) )
;; NEU: KreiselLabelSetup - Hier einfügen! ;; NEU: KreiselLabelSetup - Hier einfügen!
(defun c:KreiselLabelSetup ( / hoehe farbe abstand schriftart) (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)) (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)) (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)) (if abstand (setq *kreisel-beschriftung-abstand-oben* abstand))
(princ (strcat "\nNeue Einstellungen: Höhe=" (rtos *kreisel-beschriftung-hoehe* 2 0) (princ (ssg-textf "kreisel-labelsetup-fertig"
", Farbe=" (itoa *kreisel-beschriftung-farbe*) (list (rtos *kreisel-beschriftung-hoehe* 2 0)
", Y-Versatz=" (rtos *kreisel-beschriftung-abstand-oben* 2 0) (itoa *kreisel-beschriftung-farbe*)
", Schriftart=Arial")) (rtos *kreisel-beschriftung-abstand-oben* 2 0))))
(princ) (princ)
) )
Lisp/OmniModulInsert.lsp
+89 -79
View File
@@ -28,7 +28,7 @@
(setq data-pfad (getenv "DXFM_DATA")) (setq data-pfad (getenv "DXFM_DATA"))
(if (null data-pfad) (if (null data-pfad)
(progn (progn
(princ "\n[OMNI] FEHLER: DXFM_DATA nicht gesetzt!") (princ (ssg-text "omni-fehler-dxfm-data"))
nil nil
) )
(progn (progn
@@ -242,21 +242,21 @@
;; --- BricsCAD-Befehl: Bogen-Info anzeigen --- ;; --- BricsCAD-Befehl: Bogen-Info anzeigen ---
(defun c:OMNI_INFO_BOGEN ( / id eintrag) (defun c:OMNI_INFO_BOGEN ( / id eintrag)
(if (null *OMNI-BOEGEN*) (omni:load-data)) (if (null *OMNI-BOEGEN*) (omni:load-data))
(setq id (getstring T "\nSivasId des Bogens eingeben: ")) (setq id (getstring T (ssg-text "omni-info-bogen-prompt")))
(if (= id "") (princ "\nAbgebrochen.") (if (= id "") (princ (ssg-text "omni-abbruch"))
(progn (progn
;; Versuch als Zahl, dann als String ;; Versuch als Zahl, dann als String
(setq eintrag (omni:get-bogen (if (/= (atoi id) 0) (atoi id) id))) (setq eintrag (omni:get-bogen (if (/= (atoi id) 0) (atoi id) id)))
(if eintrag (if eintrag
(progn (progn
(princ (strcat "\n ProfilTyp: " (omni:sivasid-to-str (omni:val eintrag "ProfilTyp")))) (princ (ssg-textf "omni-bogen-info-profiltyp" (list (omni:sivasid-to-str (omni:val eintrag "ProfilTyp")))))
(princ (strcat "\n Radius: " (itoa (fix (omni:val eintrag "Radius"))))) (princ (ssg-textf "omni-bogen-info-radius" (list (itoa (fix (omni:val eintrag "Radius"))))))
(princ (strcat "\n KurvenWinkel: " (rtos (omni:val eintrag "KurvenWinkel") 2 1))) (princ (ssg-textf "omni-bogen-info-kurvenwinkel" (list (rtos (omni:val eintrag "KurvenWinkel") 2 1))))
(princ (strcat "\n Breite: " (itoa (fix (omni:val eintrag "Breite"))))) (princ (ssg-textf "omni-bogen-info-breite" (list (itoa (fix (omni:val eintrag "Breite"))))))
(princ (strcat "\n Laenge: " (itoa (fix (omni:val eintrag "Länge"))))) (princ (ssg-textf "omni-bogen-info-laenge" (list (itoa (fix (omni:val eintrag "Länge"))))))
(princ (strcat "\n Antriebsart: " (itoa (fix (omni:val eintrag "Antriebsart"))))) (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 --- ;; --- BricsCAD-Befehl: Weichen-Info anzeigen ---
(defun c:OMNI_INFO_WEICHE ( / id eintrag wkl) (defun c:OMNI_INFO_WEICHE ( / id eintrag wkl)
(if (null *OMNI-WEICHEN*) (omni:load-data)) (if (null *OMNI-WEICHEN*) (omni:load-data))
(setq id (getstring T "\nSivasId der Weiche eingeben: ")) (setq id (getstring T (ssg-text "omni-info-weiche-prompt")))
(if (= id "") (princ "\nAbgebrochen.") (if (= id "") (princ (ssg-text "omni-abbruch"))
(progn (progn
(setq eintrag (omni:get-weiche (if (/= (atoi id) 0) (atoi id) id))) (setq eintrag (omni:get-weiche (if (/= (atoi id) 0) (atoi id) id)))
(if eintrag (if eintrag
(progn (progn
(princ (strcat "\n ProfilTyp: " (omni:sivasid-to-str (omni:val eintrag "ProfilTyp")))) (princ (ssg-textf "omni-weiche-info-profiltyp" (list (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-weichentyp" (list (omni:sivasid-to-str (omni:val eintrag "WeichenTyp")))))
(setq wkl (omni:val eintrag "KurvenWinkel")) (setq wkl (omni:val eintrag "KurvenWinkel"))
(princ (strcat "\n KurvenWinkel: " (if (= (type wkl) 'INT) (itoa wkl) (rtos wkl 2 1)))) (princ (ssg-textf "omni-weiche-info-kurvenwinkel" (list (if (= (type wkl) 'INT) (itoa wkl) (rtos wkl 2 1)))))
(princ (strcat "\n Schaltungstyp: " (omni:sivasid-to-str (omni:val eintrag "Schaltungstyp")))) (princ (ssg-textf "omni-weiche-info-schaltungstyp" (list (omni:sivasid-to-str (omni:val eintrag "Schaltungstyp")))))
(princ (strcat "\n Breite: " (itoa (fix (omni:val eintrag "Breite"))))) (princ (ssg-textf "omni-weiche-info-breite" (list (itoa (fix (omni:val eintrag "Breite"))))))
(princ (strcat "\n Laenge: " (itoa (fix (omni:val eintrag "Länge"))))) (princ (ssg-textf "omni-weiche-info-laenge" (list (itoa (fix (omni:val eintrag "Länge"))))))
(princ (strcat "\n KurvenRichtung: " (itoa (fix (omni:val eintrag "KurvenRichtung"))))) (princ (ssg-textf "omni-weiche-info-kurvenrichtung" (list (itoa (fix (omni:val eintrag "KurvenRichtung"))))))
(if (omni:val eintrag "WeichenkörperLänge") (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) (if (null boegen-liste)
(progn (progn
(alert (strcat "Keine Boegen fuer " (alert (ssg-textf "omni-bogen-keine-gefunden"
(list
(strcat
(if (= (type winkel) 'INT) (itoa winkel) (rtos winkel 2 1)) (if (= (type winkel) 'INT) (itoa winkel) (rtos winkel 2 1))
" Grad" (ssg-text "omni-grad")
)
(if profiltyp (strcat " (" profiltyp ")") "") (if profiltyp (strcat " (" profiltyp ")") "")
" gefunden.")) )
))
nil nil
) )
(progn (progn
@@ -376,7 +380,7 @@
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/omniflo_boegen.dcl")) (setq dcl-pfad (strcat (getenv "DXFM_DCL") "/omniflo_boegen.dcl"))
(setq dat (load_dialog dcl-pfad)) (setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "omniflo_boegen" dat)) (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 (progn
;; Dropdown befuellen ;; Dropdown befuellen
(start_list "bogenart") (start_list "bogenart")
@@ -427,7 +431,7 @@
(setq dlg-result (omni:bogen-dialog 90 nil nil "APB 60")) (setq dlg-result (omni:bogen-dialog 90 nil nil "APB 60"))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[BOGEN] Abgebrochen.") (princ (ssg-text "omni-abbruch-bogen"))
) )
(princ) (princ)
) )
@@ -437,7 +441,7 @@
(setq dlg-result (omni:bogen-dialog 90 nil nil "APB 110")) (setq dlg-result (omni:bogen-dialog 90 nil nil "APB 110"))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[BOGEN] Abgebrochen.") (princ (ssg-text "omni-abbruch-bogen"))
) )
(princ) (princ)
) )
@@ -446,7 +450,7 @@
(setq dlg-result (omni:bogen-dialog 67.5 nil nil nil)) (setq dlg-result (omni:bogen-dialog 67.5 nil nil nil))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[BOGEN] Abgebrochen.") (princ (ssg-text "omni-abbruch-bogen"))
) )
(princ) (princ)
) )
@@ -455,7 +459,7 @@
(setq dlg-result (omni:bogen-dialog 45 nil nil nil)) (setq dlg-result (omni:bogen-dialog 45 nil nil nil))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[BOGEN] Abgebrochen.") (princ (ssg-text "omni-abbruch-bogen"))
) )
(princ) (princ)
) )
@@ -464,7 +468,7 @@
(setq dlg-result (omni:bogen-dialog 22.5 nil nil nil)) (setq dlg-result (omni:bogen-dialog 22.5 nil nil nil))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[BOGEN] Abgebrochen.") (princ (ssg-text "omni-abbruch-bogen"))
) )
(princ) (princ)
) )
@@ -473,7 +477,7 @@
(setq dlg-result (omni:bogen-dialog 180 nil nil nil)) (setq dlg-result (omni:bogen-dialog 180 nil nil nil))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[BOGEN] Abgebrochen.") (princ (ssg-text "omni-abbruch-bogen"))
) )
(princ) (princ)
) )
@@ -513,7 +517,7 @@
(setq srcAttribs (append srcAttribs (list (cons "ID" "")))) (setq srcAttribs (append srcAttribs (list (cons "ID" ""))))
) )
(if (null srcAttribs) (if (null srcAttribs)
(progn (princ "\n[OMNI] Keine Attribute im Quell-Block gefunden.") nil) (progn (princ (ssg-text "omni-insert-keine-attribute")) nil)
(progn (progn
;; LAENGEMAX aus Quell-Attribut lesen (falls vorhanden), sonst Parameter ;; LAENGEMAX aus Quell-Attribut lesen (falls vorhanden), sonst Parameter
(if (and (assoc "LAENGEMAX" srcAttribs) (if (and (assoc "LAENGEMAX" srcAttribs)
@@ -521,9 +525,9 @@
(setq laengemax (atof (cdr (assoc "LAENGEMAX" srcAttribs)))) (setq laengemax (atof (cdr (assoc "LAENGEMAX" srcAttribs))))
) )
(setq pt (getpoint "\nEinfuegepunkt waehlen: ")) (setq pt (getpoint (ssg-text "omni-prompt-einfuegepunkt")))
(if (null pt) (if (null pt)
(progn (princ "\n[OMNI] Abgebrochen.") nil) (progn (princ (ssg-text "omni-abbruch-omni")) nil)
(progn (progn
(ssg-start "OMNI Aluprofil" '(("OSMODE") ("ATTREQ") ("ATTDIA"))) (ssg-start "OMNI Aluprofil" '(("OSMODE") ("ATTREQ") ("ATTDIA")))
;; ATTREQ/ATTDIA auf 0 setzen (werden durch ssg-end wiederhergestellt) ;; ATTREQ/ATTDIA auf 0 setzen (werden durch ssg-end wiederhergestellt)
@@ -543,22 +547,20 @@
;; 2. Endpunkt fuer Fahrstrecke abfragen (Schleife bei Ueberschreitung) ;; 2. Endpunkt fuer Fahrstrecke abfragen (Schleife bei Ueberschreitung)
(setq ok nil) (setq ok nil)
(while (not ok) (while (not ok)
(setq pt2 (getpoint pt "\nEndpunkt der Fahrstrecke waehlen: ")) (setq pt2 (getpoint pt (ssg-text "omni-prompt-endpunkt-fahrstrecke")))
(if (null pt2) (if (null pt2)
(progn (progn
;; Abbruch: Text loeschen ;; Abbruch: Text loeschen
(command "_.ERASE" textEnt "") (command "_.ERASE" textEnt "")
(princ "\n[OMNI] Abgebrochen.") (princ (ssg-text "omni-abbruch-omni"))
(setq ok T pt nil) (setq ok T pt nil)
) )
(progn (progn
(setq laenge (distance (list (car pt) (cadr pt)) (setq laenge (distance (list (car pt) (cadr pt))
(list (car pt2) (cadr pt2)))) (list (car pt2) (cadr pt2))))
(if (> laenge laengemax) (if (> laenge laengemax)
(alert (strcat "Die gewuenschte Fahrstreckenlaenge von " (alert (ssg-textf "omni-laenge-ueberschritten"
(rtos laenge 2 0) " mm ueberschreitet die Maximallaenge von " (list (rtos laenge 2 0) (rtos laengemax 2 0))))
(rtos laengemax 2 0) " mm des Fahrstreckenprofils.\n"
"Bitte neu definieren!"))
(progn (progn
(setq laengeStr (rtos laenge 2 0)) (setq laengeStr (rtos laenge 2 0))
(setq dx (- (car pt2) (car pt)) (setq dx (- (car pt2) (car pt))
@@ -632,7 +634,7 @@
(ssg-id-generate blockEnt) (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) (setq ok T)
) )
) )
@@ -784,14 +786,16 @@
(if (null basis-liste) (if (null basis-liste)
(progn (progn
(alert (strcat "Keine Weichen fuer " (alert (ssg-textf "omni-weiche-keine-gefunden"
(list
(cond (cond
((null winkel) "alle Winkel") ((null winkel) (ssg-text "omni-alle-winkel"))
((= (type winkel) 'INT) (strcat (itoa winkel) " Grad")) ((= (type winkel) 'INT) (strcat (itoa winkel) (ssg-text "omni-grad")))
(T (strcat (rtos winkel 2 1) " Grad")) (T (strcat (rtos winkel 2 1) (ssg-text "omni-grad")))
) )
(if weichentyp (strcat " / " weichentyp) "") (if weichentyp (strcat " / " weichentyp) "")
" gefunden.")) )
))
nil nil
) )
(progn (progn
@@ -807,7 +811,7 @@
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/omniflo_weichen.dcl")) (setq dcl-pfad (strcat (getenv "DXFM_DCL") "/omniflo_weichen.dcl"))
(setq dat (load_dialog dcl-pfad)) (setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "omniflo_weichen" dat)) (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 (progn
;; Dropdown befuellen ;; Dropdown befuellen
(start_list "profiltyp") (start_list "profiltyp")
@@ -872,20 +876,20 @@
(setq omniflo-pfad (getenv "DXFM_OMNIFLO")) (setq omniflo-pfad (getenv "DXFM_OMNIFLO"))
(if (null omniflo-pfad) (if (null omniflo-pfad)
(progn (progn
(princ "\n[OMNI] FEHLER: DXFM_OMNIFLO nicht gesetzt!") (princ (ssg-text "omni-fehler-dxfm-omniflo"))
nil nil
) )
(progn (progn
(setq dxf-pfad (strcat omniflo-pfad "/" sivasnr-str ".dxf")) (setq dxf-pfad (strcat omniflo-pfad "/" sivasnr-str ".dxf"))
(if (not (findfile dxf-pfad)) (if (not (findfile dxf-pfad))
(progn (progn
(princ (strcat "\n[OMNI] FEHLER: DXF nicht gefunden: " dxf-pfad)) (princ (ssg-textf "omni-fehler-dxf-nicht-gefunden" (list dxf-pfad)))
nil nil
) )
(progn (progn
(setq pt (getpoint "\nEinfuegepunkt waehlen: ")) (setq pt (getpoint (ssg-text "omni-prompt-einfuegepunkt")))
(if (null pt) (if (null pt)
(progn (princ "\n[OMNI] Abgebrochen.") nil) (progn (princ (ssg-text "omni-abbruch-omni")) nil)
(progn (progn
(ssg-start "OMNI DXF Insert" '(("OSMODE") ("ATTREQ") ("ATTDIA"))) (ssg-start "OMNI DXF Insert" '(("OSMODE") ("ATTREQ") ("ATTDIA")))
(setvar "ATTREQ" 0) (setvar "ATTREQ" 0)
@@ -932,10 +936,13 @@
(ssg-id-generate blockEnt) (ssg-id-generate blockEnt)
) )
(princ (strcat "\n[OMNI] " sivasnr-str " eingefuegt." (princ (ssg-textf "omni-dxf-eingefuegt"
" Hoehe=" (if hoehe hoehe (ssg-cfg-or "omniflo" "default_hoehe" "2000")) (list
" Drehung=" (if drehung drehung (ssg-cfg-or "omniflo" "default_drehung" "0")) sivasnr-str
(if layer-name (strcat " Layer=" layer-name) ""))) (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) (ssg-end)
pt pt
) )
@@ -956,8 +963,8 @@
(setq hoehe (cadr dlg-result)) (setq hoehe (cadr dlg-result))
(setq drehung (caddr dlg-result)) (setq drehung (caddr dlg-result))
(setq sivasnr-str (omni:sivasid-to-str (omni:val eintrag "Sivasnr"))) (setq sivasnr-str (omni:sivasid-to-str (omni:val eintrag "Sivasnr")))
(princ (strcat "\n[OMNI] Einfuegen: " (princ (ssg-textf "omni-einfuegen-info"
(omni:val eintrag "ProfilTyp") " (" sivasnr-str ")")) (list (omni:val eintrag "ProfilTyp") sivasnr-str)))
(omni:insert-dxf sivasnr-str hoehe drehung) (omni:insert-dxf sivasnr-str hoehe drehung)
) )
) )
@@ -973,7 +980,7 @@
(setq dlg-result (omni:weichen-dialog 90 "Einzelweiche" nil nil)) (setq dlg-result (omni:weichen-dialog 90 "Einzelweiche" nil nil))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.") (princ (ssg-text "omni-abbruch-weiche"))
) )
(princ) (princ)
) )
@@ -982,7 +989,7 @@
(setq dlg-result (omni:weichen-dialog 90 "Doppelweiche" nil nil)) (setq dlg-result (omni:weichen-dialog 90 "Doppelweiche" nil nil))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.") (princ (ssg-text "omni-abbruch-weiche"))
) )
(princ) (princ)
) )
@@ -991,7 +998,7 @@
(setq dlg-result (omni:weichen-dialog 90 "Dreiwegeweiche" nil nil)) (setq dlg-result (omni:weichen-dialog 90 "Dreiwegeweiche" nil nil))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.") (princ (ssg-text "omni-abbruch-weiche"))
) )
(princ) (princ)
) )
@@ -1001,7 +1008,7 @@
(setq dlg-result (omni:weichen-dialog 45 "Einzelweiche" nil nil)) (setq dlg-result (omni:weichen-dialog 45 "Einzelweiche" nil nil))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.") (princ (ssg-text "omni-abbruch-weiche"))
) )
(princ) (princ)
) )
@@ -1010,7 +1017,7 @@
(setq dlg-result (omni:weichen-dialog 45 "Doppelweiche" nil nil)) (setq dlg-result (omni:weichen-dialog 45 "Doppelweiche" nil nil))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.") (princ (ssg-text "omni-abbruch-weiche"))
) )
(princ) (princ)
) )
@@ -1019,7 +1026,7 @@
(setq dlg-result (omni:weichen-dialog 45 "Dreiwegeweiche" nil nil)) (setq dlg-result (omni:weichen-dialog 45 "Dreiwegeweiche" nil nil))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.") (princ (ssg-text "omni-abbruch-weiche"))
) )
(princ) (princ)
) )
@@ -1029,7 +1036,7 @@
(setq dlg-result (omni:weichen-dialog 0 "Einzelweiche" nil nil)) (setq dlg-result (omni:weichen-dialog 0 "Einzelweiche" nil nil))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.") (princ (ssg-text "omni-abbruch-weiche"))
) )
(princ) (princ)
) )
@@ -1038,7 +1045,7 @@
(setq dlg-result (omni:weichen-dialog 0 "Doppelweiche" nil nil)) (setq dlg-result (omni:weichen-dialog 0 "Doppelweiche" nil nil))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.") (princ (ssg-text "omni-abbruch-weiche"))
) )
(princ) (princ)
) )
@@ -1047,7 +1054,7 @@
(setq dlg-result (omni:weichen-dialog 0 "Dreiwegeweiche" nil nil)) (setq dlg-result (omni:weichen-dialog 0 "Dreiwegeweiche" nil nil))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.") (princ (ssg-text "omni-abbruch-weiche"))
) )
(princ) (princ)
) )
@@ -1057,7 +1064,7 @@
(setq dlg-result (omni:weichen-dialog 22.5 "Einzelweiche" nil nil)) (setq dlg-result (omni:weichen-dialog 22.5 "Einzelweiche" nil nil))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.") (princ (ssg-text "omni-abbruch-weiche"))
) )
(princ) (princ)
) )
@@ -1066,7 +1073,7 @@
(setq dlg-result (omni:weichen-dialog 22.5 "Doppelweiche" nil nil)) (setq dlg-result (omni:weichen-dialog 22.5 "Doppelweiche" nil nil))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.") (princ (ssg-text "omni-abbruch-weiche"))
) )
(princ) (princ)
) )
@@ -1075,7 +1082,7 @@
(setq dlg-result (omni:weichen-dialog 22.5 "Dreiwegeweiche" nil nil)) (setq dlg-result (omni:weichen-dialog 22.5 "Dreiwegeweiche" nil nil))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.") (princ (ssg-text "omni-abbruch-weiche"))
) )
(princ) (princ)
) )
@@ -1085,7 +1092,7 @@
(setq dlg-result (omni:weichen-dialog nil "Deltaweiche" nil nil)) (setq dlg-result (omni:weichen-dialog nil "Deltaweiche" nil nil))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.") (princ (ssg-text "omni-abbruch-weiche"))
) )
(princ) (princ)
) )
@@ -1094,7 +1101,7 @@
(setq dlg-result (omni:weichen-dialog nil "Sternweiche" nil nil)) (setq dlg-result (omni:weichen-dialog nil "Sternweiche" nil nil))
(if dlg-result (if dlg-result
(omni:insert-from-entry dlg-result) (omni:insert-from-entry dlg-result)
(princ "\n[WEICHE] Abgebrochen.") (princ (ssg-text "omni-abbruch-weiche"))
) )
(princ) (princ)
) )
@@ -1124,7 +1131,7 @@
;; 1. Block auswaehlen (falls nicht vorselektiert) ;; 1. Block auswaehlen (falls nicht vorselektiert)
(if (null ent) (if (null ent)
(progn (progn
(setq sel (entsel "\nOmniflo-Element auswaehlen: ")) (setq sel (entsel (ssg-text "omni-edit-prompt-auswahl")))
(if sel (setq ent (car sel))) (if sel (setq ent (car sel)))
) )
) )
@@ -1132,7 +1139,7 @@
(setq ed (entget ent)) (setq ed (entget ent))
(if (/= (cdr (assoc 0 ed)) "INSERT") (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 ;; 2. Bestehende Attribute lesen
@@ -1188,7 +1195,7 @@
(if (null eintrag) (if (null eintrag)
(progn (progn
(ssg-emsg "Kein Omniflo-Element erkannt! (ARTINR/Blockname nicht im Katalog)") (ssg-emsg (ssg-text "omni-edit-kein-element"))
(ssg-end) (ssg-end)
(exit) (exit)
) )
@@ -1209,7 +1216,7 @@
) )
(if (null dlg-result) (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 ;; 5. Neuen Eintrag und Werte extrahieren
@@ -1222,7 +1229,7 @@
(setq dxf-pfad (strcat (getenv "DXFM_OMNIFLO") "/" sivasnr-str ".dxf")) (setq dxf-pfad (strcat (getenv "DXFM_OMNIFLO") "/" sivasnr-str ".dxf"))
(if (not (findfile dxf-pfad)) (if (not (findfile dxf-pfad))
(progn (progn
(ssg-emsg (strcat "DXF nicht gefunden: " dxf-pfad)) (ssg-emsg (ssg-textf "omni-edit-dxf-nicht-gefunden" (list dxf-pfad)))
(ssg-end) (ssg-end)
(exit) (exit)
) )
@@ -1251,9 +1258,12 @@
(cons "DREHUNG" (if new-drehung new-drehung (ssg-cfg-or "omniflo" "default_drehung" "0"))))) (cons "DREHUNG" (if new-drehung new-drehung (ssg-cfg-or "omniflo" "default_drehung" "0")))))
) )
(princ (strcat "\n[OMNI] Element aktualisiert: " sivasnr-str (princ (ssg-textf "omni-edit-aktualisiert"
" Hoehe=" (if new-hoehe new-hoehe (ssg-cfg-or "omniflo" "default_hoehe" "2000")) (list
" Drehung=" (if new-drehung new-drehung (ssg-cfg-or "omniflo" "default_drehung" "0")))) 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) (ssg-end)
(princ) (princ)
Lisp/SSG_LIB_Commands.lsp
+7 -7
View File
@@ -181,13 +181,13 @@
(setq ss (ssget "I")) (setq ss (ssget "I"))
(if (or (null ss) (/= (sslength ss) 1)) (if (or (null ss) (/= (sslength ss) 1))
(progn (progn
(princ "\nBlock auswaehlen: ") (princ (ssg-text "cmd-block-auswaehlen"))
(setq ss (ssget ":S" '((0 . "INSERT")))) (setq ss (ssget ":S" '((0 . "INSERT"))))
) )
) )
(if (null ss) (if (null ss)
(progn (progn
(princ "\nKein Block ausgewaehlt.") (princ (ssg-text "cmd-kein-block-ausgewaehlt"))
(princ) (princ)
(exit) (exit)
) )
@@ -198,7 +198,7 @@
(if (/= (cdr (assoc 0 ed)) "INSERT") (if (/= (cdr (assoc 0 ed)) "INSERT")
(progn (progn
(princ "\nKein Block ausgewaehlt.") (princ (ssg-text "cmd-kein-block-ausgewaehlt"))
(princ) (princ)
(exit) (exit)
) )
@@ -209,13 +209,13 @@
(cond (cond
;; Kreisel-Bloecke -> KreiselEdit ;; Kreisel-Bloecke -> KreiselEdit
((wcmatch bname "KREISEL_*") ((wcmatch bname "KREISEL_*")
(princ (strcat "\nKreisel bearbeiten: " bname)) (princ (ssg-textf "cmd-kreisel-bearbeiten" (list bname)))
(c:KreiselEdit) (c:KreiselEdit)
) )
;; Eckrad-Bloecke -> BEDIT (kein eigener Edit-Dialog in LISP) ;; Eckrad-Bloecke -> BEDIT (kein eigener Edit-Dialog in LISP)
((wcmatch bname "ECKRAD_*") ((wcmatch bname "ECKRAD_*")
(princ (strcat "\nEckrad bearbeiten: " bname)) (princ (ssg-textf "cmd-eckrad-bearbeiten" (list bname)))
(command "_.BEDIT" bname) (command "_.BEDIT" bname)
) )
@@ -230,13 +230,13 @@
(wcmatch bname "#*") (wcmatch bname "#*")
) )
) )
(princ (strcat "\nOmniflo Element bearbeiten: " bname)) (princ (ssg-textf "cmd-omniflo-bearbeiten" (list bname)))
(c:OMNI_EDIT) (c:OMNI_EDIT)
) )
;; Unbekannter Blocktyp -> natives EATTEDIT (Attribut-Editor) ;; Unbekannter Blocktyp -> natives EATTEDIT (Attribut-Editor)
(t (t
(princ (strcat "\nAttribute bearbeiten: " bname)) (princ (ssg-textf "cmd-attribute-bearbeiten" (list bname)))
(command "_.EATTEDIT") (command "_.EATTEDIT")
) )
) )
Lisp/VarioFoerderer.lsp
+1 -1
View File
@@ -17,5 +17,5 @@
) )
(if *vf-core-datei* (if *vf-core-datei*
(load *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 cfg-pfad (strcat (getenv "DXFM_CFG") "/export.cfg"))
(setq *export-cfg* (ssg-load-ini cfg-pfad)) (setq *export-cfg* (ssg-load-ini cfg-pfad))
(if (null *export-cfg*) (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) (princ)
) )
@@ -206,22 +206,22 @@
(defun csv:run-export (label py-name csv-name / ss i ename fh out-pfad (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) py-skript ergebnis-pfad cmd first-block count out-dir)
;; Vor dem Export: IDs aller Bloecke sicherstellen und Duplikate korrigieren ;; 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) (ssg-id-check-all)
;; Vor dem Export HOEHE/DREHUNG aller Omniflo-Elemente aktualisieren ;; 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) (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)) (setq ss (csv:collect-export-blocks))
(if (null ss) (if (null ss)
(progn (progn
(princ (strcat "\n[" label "] Keine relevanten Bloecke gefunden.")) (princ (ssg-textf "exp-no-blocks-found" (list label)))
(princ) (princ)
) )
(progn (progn
(setq count (sslength ss)) (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 ;; Ausgabeordner: DXFM_RESULTS, ausser *export-test-override* ist gesetzt
;; (nur waehrend TEST_EXPORT_ALL, siehe tests/test_export_all.lsp). ;; (nur waehrend TEST_EXPORT_ALL, siehe tests/test_export_all.lsp).
@@ -235,7 +235,7 @@
*export-test-override* *export-test-override*
(getenv "DXFM_RESULTS"))) (getenv "DXFM_RESULTS")))
(if (not (vl-file-directory-p out-dir)) (vl-mkdir out-dir)) (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 ;; JSON-Datei zusammenbauen
(setq out-pfad (strcat out-dir "/" (setq out-pfad (strcat out-dir "/"
@@ -243,7 +243,7 @@
(setq fh (open out-pfad "w")) (setq fh (open out-pfad "w"))
(if (null fh) (if (null fh)
(progn (progn
(princ (strcat "\n[" label "] FEHLER: Kann Datei nicht oeffnen: " out-pfad)) (princ (ssg-textf "exp-file-open-error" (list label out-pfad)))
(princ) (princ)
) )
(progn (progn
@@ -260,7 +260,7 @@
) )
(write-line "]" fh) (write-line "]" fh)
(close fh) (close fh)
(princ (strcat "\n[" label "] JSON geschrieben: " out-pfad)) (princ (ssg-textf "exp-json-written" (list label out-pfad)))
;; Python-Skript aufrufen ;; Python-Skript aufrufen
(setq py-skript (strcat (getenv "DXFM_LIB") "/" py-name)) (setq py-skript (strcat (getenv "DXFM_LIB") "/" py-name))
@@ -271,11 +271,11 @@
" \"" out-pfad "\"" " \"" out-pfad "\""
" \"" (getenv "DXFM_DATA") "\"" " \"" (getenv "DXFM_DATA") "\""
" \"" ergebnis-pfad "\"")) " \"" ergebnis-pfad "\""))
(princ (strcat "\n[" label "] Rufe Python auf...")) (princ (ssg-textf "exp-calling-python" (list label)))
(startapp "cmd" (strcat "/c " cmd)) (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) (defun c:OMNI_UPDATE_ATTRIBS ( / ss i ename ed bname teileart count)
(setq ss (ssget "X" (list (cons 0 "INSERT")))) (setq ss (ssget "X" (list (cons 0 "INSERT"))))
(if (null ss) (if (null ss)
(princ "\n[OMNI_UPDATE] Keine INSERT-Bloecke in der Zeichnung.") (princ (ssg-text "exp-omni-no-inserts"))
(progn (progn
(setq count 0) (setq count 0)
(setq i 0) (setq i 0)
@@ -418,7 +418,7 @@
) )
(setq i (1+ i)) (setq i (1+ i))
) )
(princ (strcat "\n[OMNI_UPDATE] " (itoa count) " Elemente aktualisiert (HOEHE, DREHUNG).")) (princ (ssg-textf "exp-omni-updated" (list count)))
) )
) )
(princ) (princ)
Lisp/external_call.lsp
+3 -3
View File
@@ -17,12 +17,12 @@
(setq fh (open return-datei "r")) (setq fh (open return-datei "r"))
(setq zeile (read-line fh)) (setq zeile (read-line fh))
(close 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) (princ)
) )
Lisp/ssg_core.lsp
+4 -4
View File
@@ -35,7 +35,7 @@
(setvar "CMDECHO" 0) (setvar "CMDECHO" 0)
(command "_undo" "_G") (command "_undo" "_G")
(graphscr) (graphscr)
(if titel (prompt (strcat "\n***** " titel " *****\n"))) (if titel (prompt (ssg-textf "core-start-titel" (list titel))))
(princ) (princ)
) )
@@ -65,7 +65,7 @@
(defun ssg-errhan (em) (defun ssg-errhan (em)
(if (= em "Function cancelled") (if (= em "Function cancelled")
(princ) (princ)
(progn (princ "\nFehler: ") (princ em)) (progn (princ (ssg-text "core-errhan-fehler")) (princ em))
) )
(command) (command)
(command) (command)
@@ -225,7 +225,7 @@
(command "_insert" bname pt "" "" rotation) (command "_insert" bname pt "" "" rotation)
) )
(progn (progn
(alert (strcat "Blockname '" bname "' existiert bereits - wird uebersprungen.")) (alert (ssg-textf "core-blockname-exists" (list bname)))
(setq bname (strcat "x" bname)) (setq bname (strcat "x" bname))
(command "_block" bname pt ss "") (command "_block" bname pt ss "")
(command "_insert" bname pt "" "" rotation) (command "_insert" bname pt "" "" rotation)
@@ -460,7 +460,7 @@
(defun ssg-attrib-read-dwg (dwg-pfad / tmpEnt srcAttribs oldAttreq oldAttdia) (defun ssg-attrib-read-dwg (dwg-pfad / tmpEnt srcAttribs oldAttreq oldAttdia)
(if (not (findfile dwg-pfad)) (if (not (findfile dwg-pfad))
(progn (progn
(princ (strcat "\nFEHLER: Block nicht gefunden: " dwg-pfad)) (princ (ssg-textf "core-dwg-not-found" (list dwg-pfad)))
nil nil
) )
(progn (progn
Lisp/ssg_dialog.lsp
+2 -2
View File
@@ -67,7 +67,7 @@
aktuell start-val aktuell start-val
) )
(if (not (new_dialog dialog-id dat)) (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) (set_tile select-tile start-val)
(if (and preview-tile slide-lib slide-list) (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) (defun ssg-insert-modul (lay-name lay-color blk-pfad attrib-alist rotation / pt)
(ssg-make-layer lay-name lay-color T) (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) (command "_insert" blk-pfad pt "" "" rotation)
(if attrib-alist (if attrib-alist
(ssg-attrib-set-many 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 (1+ max-id))
(setq new-id-str (ssg-id-format new-id)) (setq new-id-str (ssg-id-format new-id))
(ssg-attrib-set-on ent (list (cons "ID" new-id-str))) (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 new-id-str
) )
(progn (progn
(princ "\n[ID] FEHLER: Kein gueltiger INSERT-Block!") (princ (ssg-text "id-invalid-block"))
nil nil
) )
) )
@@ -113,7 +113,7 @@
(setq ss (ssg-id-collect-blocks)) (setq ss (ssg-id-collect-blocks))
(if (null ss) (if (null ss)
(progn (progn
(princ "\n[IDSCHECK] Keine relevanten Bloecke gefunden.") (princ (ssg-text "id-check-no-blocks"))
0 0
) )
(progn (progn
@@ -141,8 +141,8 @@
(setq max-id (1+ max-id)) (setq max-id (1+ max-id))
(setq new-id-str (ssg-id-format max-id)) (setq new-id-str (ssg-id-format max-id))
(ssg-attrib-set-on ename (list (cons "ID" new-id-str))) (ssg-attrib-set-on ename (list (cons "ID" new-id-str)))
(princ (strcat "\n[IDSCHECK] Fehlende ID gesetzt: " new-id-str (princ (ssg-textf "id-check-missing-set"
" (Block " (cdr (assoc 2 (entget ename))) ")")) (list new-id-str (cdr (assoc 2 (entget ename))))))
) )
) )
(setq i (1+ i)) (setq i (1+ i))
@@ -158,16 +158,16 @@
(setq max-id (1+ max-id)) (setq max-id (1+ max-id))
(setq new-id-str (ssg-id-format max-id)) (setq new-id-str (ssg-id-format max-id))
(ssg-attrib-set-on ename (list (cons "ID" new-id-str))) (ssg-attrib-set-on ename (list (cons "ID" new-id-str)))
(princ (strcat "\n[IDSCHECK] Duplikat ID " (ssg-id-format (car entry)) (princ (ssg-textf "id-check-duplicate"
" -> neue ID " new-id-str (list (ssg-id-format (car entry)) new-id-str
" (Block " (cdr (assoc 2 (entget ename))) ")")) (cdr (assoc 2 (entget ename))))))
(setq fixed-count (1+ fixed-count)) (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 fixed-count
) )
) )
@@ -179,7 +179,7 @@
(defun c:IDSCHECK ( / count) (defun c:IDSCHECK ( / count)
(ssg-start "IDSCHECK" nil) (ssg-start "IDSCHECK" nil)
(setq count (ssg-id-check-all)) (setq count (ssg-id-check-all))
(princ (strcat "\n[IDSCHECK] " (itoa count) " IDs korrigiert.")) (princ (ssg-textf "id-check-corrected" (list count)))
(ssg-end) (ssg-end)
(princ) (princ)
) )
@@ -188,10 +188,10 @@
;; Fordert den Benutzer auf, einen Block zu waehlen und weist eine neue ID zu. ;; Fordert den Benutzer auf, einen Block zu waehlen und weist eine neue ID zu.
(defun c:IDGENERATE ( / ent ed) (defun c:IDGENERATE ( / ent ed)
(ssg-start "IDGENERATE" nil) (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")) (if (and ent (= (cdr (assoc 0 (entget ent))) "INSERT"))
(ssg-id-generate ent) (ssg-id-generate ent)
(princ "\n[IDGENERATE] Kein gueltiger Block gewaehlt.") (princ (ssg-text "id-generate-invalid"))
) )
(ssg-end) (ssg-end)
(princ) (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 ;; Rueckgabe: neuer Layername oder nil bei Abbruch
(defun c:SSG-LayerSet (/ sel lay) (defun c:SSG-LayerSet (/ sel lay)
(ssg-start "Layer setzen" nil) (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 (progn
(command "_LAYER" "_SET" lay "") (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) (ssg-end)
lay lay
@@ -89,9 +89,9 @@
;; Layer eines Objektes anzeigen ;; Layer eines Objektes anzeigen
(defun c:SSG-LayerInfo (/ sel lay) (defun c:SSG-LayerInfo (/ sel lay)
(ssg-start "Layer-Info" nil) (ssg-start "Layer-Info" nil)
(if (setq lay (ssg-get-layer "\nObjekt waehlen: ")) (if (setq lay (ssg-get-layer (ssg-text "layer-prompt-objekt")))
(prompt (strcat "\nObjekt liegt auf Layer: " lay)) (prompt (ssg-textf "layer-objekt-auf-layer" (list lay)))
(ssg-emsg "Kein Objekt gewaehlt.") (ssg-emsg (ssg-text "layer-err-kein-objekt"))
) )
(ssg-end) (ssg-end)
lay lay
@@ -101,11 +101,11 @@
(defun c:SSG-LayerMove (/ elem ziel-lay) (defun c:SSG-LayerMove (/ elem ziel-lay)
(ssg-start "Layer wechseln" nil) (ssg-start "Layer wechseln" nil)
(if (setq elem (ssget)) (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 "") (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) (ssg-end)
) )
@@ -114,11 +114,11 @@
(defun c:SSG-LayerCopy (/ elem ziel-lay) (defun c:SSG-LayerCopy (/ elem ziel-lay)
(ssg-start "Layer-Kopie" nil) (ssg-start "Layer-Kopie" nil)
(if (setq elem (ssget)) (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 "") (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) (ssg-end)
) )
@@ -127,34 +127,34 @@
;; (nach Auswahl eines Referenz-Objektes dieses Typs) ;; (nach Auswahl eines Referenz-Objektes dieses Typs)
(defun c:SSG-LayerMoveType (/ ref-lay ref-typ elem ziel-lay ss ref-sel) (defun c:SSG-LayerMoveType (/ ref-lay ref-typ elem ziel-lay ss ref-sel)
(ssg-start "Layer-Typ verschieben" nil) (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 (progn
(setq ref-sel (entsel "\nNochmals fuer Typ-Ermittlung anklicken: ")) (setq ref-sel (entsel (ssg-text "layer-prompt-typ-ermittlung")))
(if ref-sel (if ref-sel
(progn (progn
(setq ref-typ (cdr (assoc 0 (entget (car ref-sel)))) (setq ref-typ (cdr (assoc 0 (entget (car ref-sel))))
ss (ssg-layer-ss ref-lay ref-typ) ss (ssg-layer-ss ref-lay ref-typ)
) )
(if ss (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 (progn
(ssg-zoom-save) (ssg-zoom-save)
(ssg-ss-redraw ss 3) (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 "") (command "_CHANGE" ss "" "_PROP" "_LA" ziel-lay "")
(ssg-ss-redraw ss 4) (ssg-ss-redraw ss 4)
) )
(ssg-zoom-restore) (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) (ssg-end)
) )
@@ -167,10 +167,10 @@
;; Layer durch Anklicken ausschalten ;; Layer durch Anklicken ausschalten
(defun c:SSG-LayerOff (/ lay) (defun c:SSG-LayerOff (/ lay)
(ssg-start "Layer ausschalten" nil) (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) (if (ssg-layer-safe-p lay nil)
(command "_LAYER" "_OFF" lay "") (command "_LAYER" "_OFF" lay "")
(ssg-emsg "Aktiven Layer nicht ausschalten!") (ssg-emsg (ssg-text "layer-err-aktiv-nicht-ausschalten"))
) )
) )
(ssg-end) (ssg-end)
@@ -179,10 +179,10 @@
;; Layer durch Anklicken einfrieren ;; Layer durch Anklicken einfrieren
(defun c:SSG-LayerFreeze (/ lay) (defun c:SSG-LayerFreeze (/ lay)
(ssg-start "Layer einfrieren" nil) (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) (if (ssg-layer-safe-p lay nil)
(command "_LAYER" "_FR" lay "") (command "_LAYER" "_FR" lay "")
(ssg-emsg "Aktiven Layer nicht einfrieren!") (ssg-emsg (ssg-text "layer-err-aktiv-nicht-einfrieren"))
) )
) )
(ssg-end) (ssg-end)
@@ -191,13 +191,13 @@
;; Alle Layer ausser dem aktiven einfrieren ;; Alle Layer ausser dem aktiven einfrieren
(defun c:SSG-FreezeAll (/ aktiv) (defun c:SSG-FreezeAll (/ aktiv)
(ssg-start "Alle anderen Layer einfrieren" nil) (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 (if aktiv
(progn (progn
(command "_LAYER" "_SET" aktiv "_FR" "*" "") (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) (ssg-end)
) )
@@ -278,34 +278,34 @@
(defun c:SSG-LayerDelete (/ lay ss) (defun c:SSG-LayerDelete (/ lay ss)
(ssg-start "Layer loeschen" nil) (ssg-start "Layer loeschen" nil)
(initget 1) (initget 1)
(setq lay (getstring "\nLayername zum Loeschen: ")) (setq lay (getstring (ssg-text "layer-prompt-name-loeschen")))
(if (tblsearch "LAYER" lay) (if (tblsearch "LAYER" lay)
(progn (progn
(setq ss (ssg-layer-ss lay nil)) (setq ss (ssg-layer-ss lay nil))
(if ss (if ss
(progn (progn
(ssg-ss-redraw ss 4) (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 (progn
(command "_ERASE" ss "") (command "_ERASE" ss "")
(command "_LAYER" "_OFF" lay "") (command "_LAYER" "_OFF" lay "")
(command "_PURGE" "_LA" lay "N") (command "_PURGE" "_LA" lay "N")
(prompt (strcat "\nLayer '" lay "' geloescht.")) (prompt (ssg-textf "layer-geloescht" (list lay)))
) )
(progn (progn
(ssg-ss-redraw ss 0) (ssg-ss-redraw ss 0)
(prompt "\nAbgebrochen.") (prompt (strcat "\n" (ssg-text "layer-abgebrochen")))
) )
) )
) )
(progn (progn
(command "_LAYER" "_OFF" lay "") (command "_LAYER" "_OFF" lay "")
(command "_PURGE" "_LA" lay "N") (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) (ssg-end)
) )
Lisp/vf_core.lsp
+73 -86
View File
@@ -253,14 +253,14 @@
(setq block-datei (strcat block-pfad blockname ".dwg")) (setq block-datei (strcat block-pfad blockname ".dwg"))
(if (findfile block-datei) (if (findfile block-datei)
(progn (progn
(princ (strcat "\n Lade Block: " blockname " ...")) (princ (ssg-textf "vfc-lade-block" (list blockname)))
(setq temp-obj (vla-InsertBlock modelspace (setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0)) (vlax-3D-point '(0 0 0))
block-datei 1.0 1.0 1.0 0)) block-datei 1.0 1.0 1.0 0))
(vla-Delete temp-obj) (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) (defun get-3d-point-from-object (msg / ent obj pt variant)
(princ msg) (princ msg)
(princ "\n >> Objekt (Block) waehlen: ") (princ (ssg-text "vfc-objekt-block-waehlen"))
(setq ent (entsel)) (setq ent (entsel))
(if ent (if ent
(progn (progn
@@ -350,17 +350,17 @@
(progn (progn
(setq variant (vla-get-InsertionPoint obj)) (setq variant (vla-get-InsertionPoint obj))
(setq pt (vlax-safearray->list (vlax-variant-value variant))) (setq pt (vlax-safearray->list (vlax-variant-value variant)))
(princ (strcat "\n Block-Einfuegepunkt: X=" (rtos (car pt) 2 3) (princ (ssg-textf "vfc-block-einfuegepunkt"
" Y=" (rtos (cadr pt) 2 3) " Z=" (rtos (caddr pt) 2 3))) (list (rtos (car pt) 2 3) (rtos (cadr pt) 2 3) (rtos (caddr pt) 2 3))))
) )
(progn (progn
(setq pt (cadr ent)) (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 (progn
(princ "\n Kein Objekt gewaehlt.") (princ (ssg-text "vfc-kein-objekt-gewaehlt"))
(setq pt nil) (setq pt nil)
) )
) )
@@ -369,7 +369,7 @@
(defun get-line-start-end-points (msg / ent obj obj-name start-pt end-pt) (defun get-line-start-end-points (msg / ent obj obj-name start-pt end-pt)
(princ msg) (princ msg)
(princ "\n >> 3D-Linie oder Polylinie waehlen: ") (princ (ssg-text "vfc-linie-polylinie-waehlen"))
(setq ent (entsel)) (setq ent (entsel))
(if ent (if ent
(progn (progn
@@ -381,29 +381,24 @@
(vlax-variant-value (vla-get-StartPoint obj)))) (vlax-variant-value (vla-get-StartPoint obj))))
(setq end-pt (vlax-safearray->list (setq end-pt (vlax-safearray->list
(vlax-variant-value (vla-get-EndPoint obj)))) (vlax-variant-value (vla-get-EndPoint obj))))
(princ (strcat "\n 3D-Linie:" (princ (ssg-textf "vfc-3dlinie-start-ende"
"\n Start: X=" (rtos (car start-pt) 2 2) (list (rtos (car start-pt) 2 2) (rtos (cadr start-pt) 2 2) (rtos (caddr start-pt) 2 2)
" Y=" (rtos (cadr start-pt) 2 2) (rtos (car end-pt) 2 2) (rtos (cadr end-pt) 2 2) (rtos (caddr end-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)))
) )
((= obj-name "AcDbPolyline") ((= obj-name "AcDbPolyline")
(setq start-pt (vlax-curve-getStartPoint obj)) (setq start-pt (vlax-curve-getStartPoint obj))
(setq end-pt (vlax-curve-getEndPoint obj)) (setq end-pt (vlax-curve-getEndPoint obj))
(princ (strcat "\n 3D-Polylinie:" (princ (ssg-textf "vfc-3dpolylinie-start-ende"
"\n Start Z=" (rtos (caddr start-pt) 2 2) (list (rtos (caddr start-pt) 2 2) (rtos (caddr end-pt) 2 2))))
" Ende Z=" (rtos (caddr end-pt) 2 2)))
) )
(t (t
(princ "\n FEHLER: Keine Linie oder Polylinie ausgewaehlt!") (princ (ssg-text "vfc-fehler-keine-linie"))
(setq start-pt nil end-pt nil) (setq start-pt nil end-pt nil)
) )
) )
) )
(progn (progn
(princ "\n Kein Objekt gewaehlt.") (princ (ssg-text "vfc-kein-objekt-gewaehlt"))
(setq start-pt nil end-pt nil) (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) 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))) (if (or (null einfuegepunkt) (not (listp einfuegepunkt)))
(progn (progn
(princ (strcat "\n FEHLER: Ungueltiger Einfuegepunkt fuer '" blockname "'")) (princ (ssg-textf "vfc-fehler-ungueltiger-einfuegepunkt" (list blockname)))
(exit) (exit)
) )
) )
(ensure-block-loaded blockname) (ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname)) (if (not (tblsearch "BLOCK" blockname))
(progn (progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen")) (princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek-abgebrochen" (list blockname)))
(exit) (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 rad-h (* (float hz) (/ pi 180.0)))
(setq chv (cos rad-h) shv (sin rad-h)) (setq chv (cos rad-h) shv (sin rad-h))
;; KS_EIN/KS_AUS ueber eigenes Temp-Objekt am Ursprung ermitteln (nicht am ;; 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))) (+ (car einfuegepunkt) (- (* chv dx-loc) (* shv dy-loc)))
(+ (cadr einfuegepunkt) (+ (* shv dx-loc) (* chv dy-loc))) (+ (cadr einfuegepunkt) (+ (* shv dx-loc) (* chv dy-loc)))
(+ (caddr einfuegepunkt) dz-loc))) (+ (caddr einfuegepunkt) dz-loc)))
(princ (strcat "\n KS_AUS: X=" (rtos (car ausgang) 2 2) (princ (ssg-textf "vfc-ks-aus-xyz"
" Y=" (rtos (cadr ausgang) 2 2) (list (rtos (car ausgang) 2 2) (rtos (cadr ausgang) 2 2) (rtos (caddr ausgang) 2 2))))
" Z=" (rtos (caddr ausgang) 2 2)))
ausgang ausgang
) )
(progn (progn
(princ "\n WARNUNG: KS_EIN/KS_AUS nicht gefunden!") (princ (ssg-text "vfc-warnung-ks-nicht-gefunden"))
einfuegepunkt einfuegepunkt
) )
) )
@@ -523,7 +517,7 @@
(ensure-block-loaded blockname) (ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname)) (if (not (tblsearch "BLOCK" blockname))
(progn (progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek")) (princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek" (list blockname)))
(exit))) (exit)))
;; Ziel-Rahmen auspacken ;; Ziel-Rahmen auspacken
(setq P-t (car target-frame) (setq P-t (car target-frame)
@@ -543,7 +537,7 @@
(setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data))) (setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data)))
(if (not (and ks-ein-raw ks-aus-raw)) (if (not (and ks-ein-raw ks-aus-raw))
(progn (progn
(princ (strcat "\n FEHLER: KS_EIN/KS_AUS fehlen in '" blockname "'")) (princ (ssg-textf "vfc-fehler-ks-fehlen" (list blockname)))
(exit))) (exit)))
;; Block am Ursprung einfuegen (Rotation=0, Massstab=1) - dieses Objekt ;; Block am Ursprung einfuegen (Rotation=0, Massstab=1) - dieses Objekt
;; bleibt tatsaechlich in der Zeichnung. ;; bleibt tatsaechlich in der Zeichnung.
@@ -583,10 +577,8 @@
(setq xu-out (mat3-mul-vec3 R xu-aus) (setq xu-out (mat3-mul-vec3 R xu-aus)
yu-out (mat3-mul-vec3 R yu-aus) yu-out (mat3-mul-vec3 R yu-aus)
zu-out (mat3-mul-vec3 R zu-aus)) zu-out (mat3-mul-vec3 R zu-aus))
(princ (strcat "\n '" blockname "' eingefuegt" (princ (ssg-textf "vfc-block-eingefuegt-ksaus"
"\n KS_AUS: X=" (rtos (car P-out) 2 2) (list blockname (rtos (car P-out) 2 2) (rtos (cadr P-out) 2 2) (rtos (caddr P-out) 2 2))))
" Y=" (rtos (cadr P-out) 2 2)
" Z=" (rtos (caddr P-out) 2 2)))
(list P-out xu-out yu-out zu-out)) (list P-out xu-out yu-out zu-out))
;; Fuegt Block ein: Orientierung wie insert-block-ks-to-ks (KS_EIN-Achsen werden ;; Fuegt Block ein: Orientierung wie insert-block-ks-to-ks (KS_EIN-Achsen werden
@@ -613,7 +605,7 @@
(ensure-block-loaded blockname) (ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname)) (if (not (tblsearch "BLOCK" blockname))
(progn (progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek")) (princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek" (list blockname)))
(exit))) (exit)))
;; Ziel-Rahmen auspacken ;; Ziel-Rahmen auspacken
(setq P-t (car target-frame) (setq P-t (car target-frame)
@@ -633,7 +625,7 @@
(setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data))) (setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data)))
(if (not (and ks-ein-raw ks-aus-raw)) (if (not (and ks-ein-raw ks-aus-raw))
(progn (progn
(princ (strcat "\n FEHLER: KS_EIN/KS_AUS fehlen in '" blockname "'")) (princ (ssg-textf "vfc-fehler-ks-fehlen" (list blockname)))
(exit))) (exit)))
;; Block am Ursprung einfuegen (Rotation=0, Massstab=1) - dieses Objekt ;; Block am Ursprung einfuegen (Rotation=0, Massstab=1) - dieses Objekt
;; bleibt tatsaechlich in der Zeichnung. ;; bleibt tatsaechlich in der Zeichnung.
@@ -681,11 +673,11 @@
(setq xu-out (mat3-mul-vec3 R xu-aus) (setq xu-out (mat3-mul-vec3 R xu-aus)
yu-out (mat3-mul-vec3 R yu-aus) yu-out (mat3-mul-vec3 R yu-aus)
zu-out (mat3-mul-vec3 R zu-aus)) zu-out (mat3-mul-vec3 R zu-aus))
(princ (strcat "\n '" blockname "' eingefuegt (XY:" (if xy-ref xy-ref "Ursprung") (princ (ssg-textf "vfc-block-eingefuegt-xyzref-ksaus"
" Z:" (if z-ref z-ref "Ursprung") ")" (list blockname
"\n KS_AUS: X=" (rtos (car P-out) 2 2) (if xy-ref xy-ref (ssg-text "vfc-ursprung"))
" Y=" (rtos (cadr P-out) 2 2) (if z-ref z-ref (ssg-text "vfc-ursprung"))
" Z=" (rtos (caddr P-out) 2 2))) (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)) (list P-out xu-out yu-out zu-out))
;; hz: horizontale Fahrtrichtung in Grad (0=Ost/+X, 90=Nord/+Y, ...), ;; 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) rad-v rad-h chv shv cvv svv matrix block-obj endpunkt scale)
(if (<= laenge 0.1) (if (<= laenge 0.1)
(progn (progn
(princ (strcat "\n Laenge=" (rtos laenge 2 2) " mm -> uebersprungen")) (princ (ssg-textf "vfc-laenge-uebersprungen" (list (rtos laenge 2 2))))
startpunkt startpunkt
) )
(progn (progn
(ensure-block-loaded blockname) (ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname)) (if (not (tblsearch "BLOCK" blockname))
(progn (progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen")) (princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek-abgebrochen" (list blockname)))
(exit) (exit)
) )
) )
(princ (strcat "\n Fuege '" blockname "' ein" (princ (ssg-textf "vfc-fuege-ein-lwhz"
" (L=" (rtos laenge 2 2) " mm, W=" (itoa winkel) (chr 176) (list blockname (rtos laenge 2 2) (itoa winkel) (chr 176) (rtos (float hz) 2 1) (chr 176))))
" hz=" (rtos (float hz) 2 1) (chr 176) ")"))
(setq scale (/ laenge (ssg-cfg-or "vario" "skalierung_basis" 1000.0))) (setq scale (/ laenge (ssg-cfg-or "vario" "skalierung_basis" 1000.0)))
(setq rad-v (* (float winkel) (/ pi 180.0))) (setq rad-v (* (float winkel) (/ pi 180.0)))
(setq rad-h (* (float hz) (/ pi 180.0))) (setq rad-h (* (float hz) (/ pi 180.0)))
@@ -729,9 +720,8 @@
(+ (car startpunkt) (* laenge chv cvv)) (+ (car startpunkt) (* laenge chv cvv))
(+ (cadr startpunkt) (* laenge shv cvv)) (+ (cadr startpunkt) (* laenge shv cvv))
(+ (caddr startpunkt) (* laenge (- svv))))) (+ (caddr startpunkt) (* laenge (- svv)))))
(princ (strcat "\n Endpunkt: X=" (rtos (car endpunkt) 2 2) (princ (ssg-textf "vfc-endpunkt-xyz"
" Y=" (rtos (cadr endpunkt) 2 2) (list (rtos (car endpunkt) 2 2) (rtos (cadr endpunkt) 2 2) (rtos (caddr endpunkt) 2 2))))
" Z=" (rtos (caddr endpunkt) 2 2)))
endpunkt endpunkt
) )
) )
@@ -759,20 +749,19 @@
dx dz ins-pt endpunkt) dx dz ins-pt endpunkt)
(if (or (null startpunkt) (not (listp startpunkt))) (if (or (null startpunkt) (not (listp startpunkt)))
(progn (progn
(princ (strcat "\n FEHLER: Ungueltiger Einfuegepunkt fuer '" blockname "'")) (princ (ssg-textf "vfc-fehler-ungueltiger-einfuegepunkt" (list blockname)))
startpunkt startpunkt
) )
(progn (progn
(ensure-block-loaded blockname) (ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname)) (if (not (tblsearch "BLOCK" blockname))
(progn (progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen")) (princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek-abgebrochen" (list blockname)))
(exit) (exit)
) )
) )
(princ (strcat "\n Fuege Block '" blockname "' ein" (princ (ssg-textf "vfc-fuege-block-ein-rotation-hz"
" (Rotation " (itoa winkel) (chr 176) (list blockname (itoa winkel) (chr 176) (rtos (float hz) 2 1) (chr 176))))
" hz=" (rtos (float hz) 2 1) (chr 176) ")"))
(setq rad-v (* winkel (/ pi 180.0))) (setq rad-v (* winkel (/ pi 180.0)))
(setq rad-h (* (float hz) (/ 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)) (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))) (+ (car startpunkt) (+ (* dx chv cvv) (* dz chv svv)))
(+ (cadr startpunkt) (+ (* dx shv cvv) (* dz shv svv))) (+ (cadr startpunkt) (+ (* dx shv cvv) (* dz shv svv)))
(+ (caddr startpunkt) (+ (* dx (- svv)) (* dz cvv))))) (+ (caddr startpunkt) (+ (* dx (- svv)) (* dz cvv)))))
(princ (strcat "\n Endpunkt: X=" (rtos (car endpunkt) 2 2) (princ (ssg-textf "vfc-endpunkt-xyz-dxdz"
" Y=" (rtos (cadr endpunkt) 2 2) (list (rtos (car endpunkt) 2 2) (rtos (cadr endpunkt) 2 2) (rtos (caddr endpunkt) 2 2)
" Z=" (rtos (caddr endpunkt) 2 2) (rtos dx 2 1) (rtos dz 2 1))))
" (dx=" (rtos dx 2 1) " dz=" (rtos dz 2 1) ")"))
endpunkt endpunkt
) )
) )
@@ -842,24 +830,24 @@
;; ============================================================ ;; ============================================================
(defun vf-eingabe-abfragen ( / eingabe-modus line-points startpunkt endpunkt differenz (defun vf-eingabe-abfragen ( / eingabe-modus line-points startpunkt endpunkt differenz
deltaL deltaH deltaX deltaY richtung antwort hz-winkel) deltaL deltaH deltaX deltaY richtung antwort hz-winkel)
(princ "\n\nEingabemodus waehlen:") (princ (ssg-text "vfc-eingabemodus-header"))
(princ "\n 1 - 3D-Linie auswaehlen (Start- und Endpunkt mit Hoehe)") (princ (ssg-text "vfc-eingabemodus-3dlinie"))
(princ "\n 2 - Werte manuell eingeben") (princ (ssg-text "vfc-eingabemodus-werte"))
(setq antwort (getstring "\nIhre Wahl (1/2): ")) (setq antwort (getstring (ssg-text "vfc-prompt-wahl-1-2-ohne-default")))
(cond (cond
((= antwort "1") (setq eingabe-modus "Linie")) ((= antwort "1") (setq eingabe-modus "Linie"))
((= antwort "2") (setq eingabe-modus "Wert")) ((= 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") (if (= eingabe-modus "Linie")
(progn (progn
(princ "\n\n>>> MODUS: 3D-Linie auswaehlen <<<") (princ (ssg-text "vfc-modus-3dlinie-header"))
(command "BKS" "W") (command "BKS" "W")
(princ "\n BKS auf Weltkoordinaten gesetzt.") (princ (ssg-text "vfc-bks-weltkoordinaten"))
(setq line-points (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) (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) (setq startpunkt (car line-points)
endpunkt (cadr line-points)) endpunkt (cadr line-points))
@@ -871,20 +859,19 @@
;; Fahrtrichtung aus der Linie ableiten (0=Ost, 90=Nord, ...) ;; Fahrtrichtung aus der Linie ableiten (0=Ost, 90=Nord, ...)
(setq hz-winkel (setq hz-winkel
(* (angle '(0.0 0.0) (list (car differenz) (cadr differenz))) (/ 180.0 pi))) (* (angle '(0.0 0.0) (list (car differenz) (cadr differenz))) (/ 180.0 pi)))
(princ (strcat "\n △L=" (rtos deltaL 2 2) " mm" (princ (ssg-textf "vfc-delta-l-h-richtung"
" △H=" (rtos deltaH 2 2) " mm" (list (chr 916) (rtos deltaL 2 2) (rtos deltaH 2 2) (rtos hz-winkel 2 1) grad-zeichen)))
" Fahrtrichtung=" (rtos hz-winkel 2 1) grad-zeichen))
(if (>= deltaH 0) (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)) (progn (setq richtung "Ab") (setq deltaH (abs deltaH))
(princ "\n Foerderrichtung: AB")) (princ (ssg-text "vfc-foerderrichtung-ab")))
) )
) )
(progn (progn
(princ "\n\n>>> MODUS: Manuelle Werteingabe <<<") (princ (ssg-text "vfc-modus-werteingabe-header"))
(setq deltaL (getreal "\n△L - Horizontale Distanz (mm): ")) (setq deltaL (getreal (ssg-textf "vfc-prompt-delta-l" (list (chr 916)))))
(if (null deltaL) (setq deltaL 15000)) (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)) (if (null deltaH) (setq deltaH 3000))
;; Foerderrichtung bleibt eine einfache Auf/Ab-Frage - die horizontale ;; Foerderrichtung bleibt eine einfache Auf/Ab-Frage - die horizontale
;; Zwischenstrecke ist geometrisch NUR bei "Ab" ueberhaupt erreichbar ;; Zwischenstrecke ist geometrisch NUR bei "Ab" ueberhaupt erreichbar
@@ -892,25 +879,25 @@
;; erst SPAETER, nach Bibliotheks-Init, als Zusatzoption in der ;; erst SPAETER, nach Bibliotheks-Init, als Zusatzoption in der
;; Winkel-Auswahl angeboten (siehe c:VarioFoerderer) - einheitlich fuer ;; Winkel-Auswahl angeboten (siehe c:VarioFoerderer) - einheitlich fuer
;; Werteingabe UND 3D-Linie. ;; Werteingabe UND 3D-Linie.
(princ "\nFoerderrichtung:\n 1 - AUF\n 2 - AB") (princ (ssg-text "vfc-foerderrichtung-menu"))
(setq antwort (getstring "\nIhre Wahl (1/2): ")) (setq antwort (getstring (ssg-text "vfc-prompt-wahl-1-2-ohne-default")))
(if (= antwort "2") (setq richtung "Ab") (setq richtung "Auf")) (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))) (if (null startpunkt) (setq startpunkt '(0 0 0)))
;; Horizontale Fahrtrichtung waehlen (analog Gefaellestrecke Modus 1) ;; Horizontale Fahrtrichtung waehlen (analog Gefaellestrecke Modus 1)
(princ "\n\nFahrtrichtung waehlen:") (princ (ssg-text "vfc-fahrtrichtung-header"))
(princ "\n 1 - 0° (X-Achse +, Ost)") (princ (ssg-textf "vfc-fahrtrichtung-0" (list grad-zeichen)))
(princ "\n 2 - 90° (Y-Achse +, Nord)") (princ (ssg-textf "vfc-fahrtrichtung-90" (list grad-zeichen)))
(princ "\n 3 - 180° (X-Achse -, West)") (princ (ssg-textf "vfc-fahrtrichtung-180" (list grad-zeichen)))
(princ "\n 4 - 270° (Y-Achse -, Sued)") (princ (ssg-textf "vfc-fahrtrichtung-270" (list grad-zeichen)))
(setq antwort (getstring "\nIhre Wahl (1/2/3/4) [1]: ")) (setq antwort (getstring (ssg-text "prompt-wahl-1-2-3-4")))
(cond (cond
((= antwort "2") (setq hz-winkel 90.0)) ((= antwort "2") (setq hz-winkel 90.0))
((= antwort "3") (setq hz-winkel 180.0)) ((= antwort "3") (setq hz-winkel 180.0))
((= antwort "4") (setq hz-winkel 270.0)) ((= antwort "4") (setq hz-winkel 270.0))
(t (setq hz-winkel 0.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) (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 L_GF_str (strcat (rtos (/ L_GF1 1000.0) 2 3) "," (rtos (/ L_GF2 1000.0) 2 3)))
(setq label-txt (setq label-txt
(strcat "VF" (itoa vf-nummer) (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 "H=" (itoa (fix deltaH)) "mm; "
delta-sym "L=" (itoa (fix deltaL)) "mm; " delta-sym "L=" (itoa (fix deltaL)) "mm; "
"VF:" L_VF_str "m; GF:" L_GF_str "m; " "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* (if *vf-etage-core-pfad*
(load (strcat *vf-etage-core-pfad* "/vf_core.lsp")) (load (strcat *vf-etage-core-pfad* "/vf_core.lsp"))
(progn (progn
(princ "\n[vf_etage] WARNUNG: Lisp-Pfad nicht ermittelbar - vf_core.lsp nicht ladbar!") (princ (ssg-text "vfe-warn-lisp-pfad"))
(exit) (exit)
) )
) )
@@ -50,9 +50,9 @@
(if (and *etage-lib-initialized* (not (tblsearch "BLOCK" "AS_Element_30_rechts"))) (if (and *etage-lib-initialized* (not (tblsearch "BLOCK" "AS_Element_30_rechts")))
(setq *etage-lib-initialized* nil)) (setq *etage-lib-initialized* nil))
(if *etage-lib-initialized* (if *etage-lib-initialized*
(progn (princ "\n Etage-Bibliothek bereits initialisiert.") t) (progn (princ (ssg-text "vfe-bib-bereits-init")) t)
(progn (progn
(princ "\n Initialisiere Etage-Bibliothek...") (princ (ssg-text "vfe-bib-initialisiere"))
;; Standard-Bogen-Daten laden (bogen-auf/bogen-ab benoetigt) ;; Standard-Bogen-Daten laden (bogen-auf/bogen-ab benoetigt)
(if (not *lib-initialized*) (if (not *lib-initialized*)
@@ -60,7 +60,7 @@
) )
;; AS_30_rechts Masse extrahieren ;; 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_rechts")
(ensure-block-loaded "AS_Element_30_links") (ensure-block-loaded "AS_Element_30_links")
(if (tblsearch "BLOCK" "AS_Element_30_rechts") (if (tblsearch "BLOCK" "AS_Element_30_rechts")
@@ -79,23 +79,22 @@
(progn (progn
(setq etage-aus-dx (- (caar ks-aus-pos) (caar ks-ein-pos))) (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)))) (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) (princ (ssg-textf "vfe-as30-mass" (list (rtos etage-aus-dx 2 1) (rtos etage-aus-dz 2 1))))
" mm, dz=" (rtos etage-aus-dz 2 1) " mm"))
) )
(progn (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) (setq etage-aus-dx 525.8 etage-aus-dz -72.9)
) )
) )
) )
(progn (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) (setq etage-aus-dx 525.8 etage-aus-dz -72.9)
) )
) )
;; ES_30_rechts Masse extrahieren ;; 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_rechts")
(ensure-block-loaded "ES_Element_30_links") (ensure-block-loaded "ES_Element_30_links")
(if (tblsearch "BLOCK" "ES_Element_30_rechts") (if (tblsearch "BLOCK" "ES_Element_30_rechts")
@@ -114,24 +113,23 @@
(progn (progn
(setq etage-ein-dx (- (caar ks-aus-pos) (caar ks-ein-pos))) (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)))) (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) (princ (ssg-textf "vfe-es30-mass" (list (rtos etage-ein-dx 2 1) (rtos etage-ein-dz 2 1))))
" mm, dz=" (rtos etage-ein-dz 2 1) " mm"))
) )
(progn (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) (setq etage-ein-dx 576.2 etage-ein-dz -54.6)
) )
) )
) )
(progn (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) (setq etage-ein-dx 576.2 etage-ein-dz -54.6)
) )
) )
;; Gefaellebogen_links_60 Masse extrahieren ;; Gefaellebogen_links_60 Masse extrahieren
(setq gefaelle-blockname "Gefaellebogen_links_60_R500") (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) (ensure-block-loaded gefaelle-blockname)
(if (tblsearch "BLOCK" gefaelle-blockname) (if (tblsearch "BLOCK" gefaelle-blockname)
(progn (progn
@@ -150,22 +148,21 @@
(setq etage-gef-dz-links (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos)))) (setq etage-gef-dz-links (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
) )
(progn (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) (setq etage-gef-dx-links 0.0 etage-gef-dz-links -10.0)
) )
) )
) )
(progn (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) (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) (princ (ssg-textf "vfe-gefaellebogen-links-mass" (list (rtos etage-gef-dx-links 2 2) (rtos etage-gef-dz-links 2 2))))
" dz=" (rtos etage-gef-dz-links 2 2) " mm"))
;; Gefaellebogen_rechts_60 Masse extrahieren ;; Gefaellebogen_rechts_60 Masse extrahieren
(setq gefaelle-blockname "Gefaellebogen_rechts_60_R500") (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) (ensure-block-loaded gefaelle-blockname)
(if (tblsearch "BLOCK" gefaelle-blockname) (if (tblsearch "BLOCK" gefaelle-blockname)
(progn (progn
@@ -184,21 +181,20 @@
(setq etage-gef-dz-rechts (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos)))) (setq etage-gef-dz-rechts (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
) )
(progn (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) (setq etage-gef-dx-rechts 0.0 etage-gef-dz-rechts -10.0)
) )
) )
) )
(progn (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) (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) (princ (ssg-textf "vfe-gefaellebogen-rechts-mass" (list (rtos etage-gef-dx-rechts 2 2) (rtos etage-gef-dz-rechts 2 2))))
" dz=" (rtos etage-gef-dz-rechts 2 2) " mm"))
(setq *etage-lib-initialized* t) (setq *etage-lib-initialized* t)
(princ "\n Etage-Bibliothek erfolgreich initialisiert.") (princ (ssg-text "vfe-bib-init-erfolg"))
t t
) )
) )
@@ -223,7 +219,7 @@
(ensure-block-loaded blockname) (ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname)) (if (not (tblsearch "BLOCK" blockname))
(progn (progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen")) (princ (ssg-textf "vfe-block-fehlt-abbruch" (list blockname)))
(exit) (exit)
) )
) )
@@ -241,10 +237,11 @@
(+ (car startpunkt) (* laenge chz cv)) (+ (car startpunkt) (* laenge chz cv))
(+ (cadr startpunkt) (* laenge shz cv)) (+ (cadr startpunkt) (* laenge shz cv))
(+ (caddr startpunkt) (* (- sv) laenge)))) (+ (caddr startpunkt) (* (- sv) laenge))))
(princ (strcat "\n HzIncl " blockname " L=" (rtos laenge 2 0) (princ (ssg-textf "vfe-hz-incl-status"
" hz=" (rtos hz-winkel 2 0) (chr 176) (list blockname (rtos laenge 2 0)
" v=" (rtos vert-winkel 2 0) (chr 176) (strcat (rtos hz-winkel 2 0) (chr 176))
" -> Z=" (rtos (caddr endpunkt) 2 1))) (strcat (rtos vert-winkel 2 0) (chr 176))
(rtos (caddr endpunkt) 2 1))))
endpunkt endpunkt
) )
@@ -258,7 +255,7 @@
(ensure-block-loaded blockname) (ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname)) (if (not (tblsearch "BLOCK" blockname))
(progn (progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen")) (princ (ssg-textf "vfe-block-fehlt-abbruch" (list blockname)))
(exit) (exit)
) )
) )
@@ -276,10 +273,11 @@
(+ (car startpunkt) (+ (* block-dx chz cv) (* block-dz chz sv))) (+ (car startpunkt) (+ (* block-dx chz cv) (* block-dz chz sv)))
(+ (cadr startpunkt) (+ (* block-dx shz cv) (* block-dz shz sv))) (+ (cadr startpunkt) (+ (* block-dx shz cv) (* block-dz shz sv)))
(+ (caddr startpunkt) (+ (* (- sv) block-dx) (* cv block-dz))))) (+ (caddr startpunkt) (+ (* (- sv) block-dx) (* cv block-dz)))))
(princ (strcat "\n HzRot " blockname (princ (ssg-textf "vfe-hz-rot-status"
" hz=" (rtos hz-winkel 2 0) (chr 176) (list blockname
" v=" (rtos vert-winkel 2 0) (chr 176) (strcat (rtos hz-winkel 2 0) (chr 176))
" -> Z=" (rtos (caddr endpunkt) 2 1))) (strcat (rtos vert-winkel 2 0) (chr 176))
(rtos (caddr endpunkt) 2 1))))
endpunkt endpunkt
) )
@@ -291,7 +289,7 @@
(ensure-block-loaded blockname) (ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname)) (if (not (tblsearch "BLOCK" blockname))
(progn (progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen")) (princ (ssg-textf "vfe-block-fehlt-abbruch" (list blockname)))
(exit) (exit)
) )
) )
@@ -335,13 +333,14 @@
(setq ausgang (list (+ (car p-aus-rot) (car offset)) (setq ausgang (list (+ (car p-aus-rot) (car offset))
(+ (cadr p-aus-rot) (cadr offset)) (+ (cadr p-aus-rot) (cadr offset))
(+ (caddr p-aus-rot) (caddr offset)))) (+ (caddr p-aus-rot) (caddr offset))))
(princ (strcat "\n HzRotKS " blockname (princ (ssg-textf "vfe-hz-rotks-status"
" hz=" (rtos hz-winkel 2 0) (chr 176) (list blockname
" -> Z=" (rtos (caddr ausgang) 2 1))) (strcat (rtos hz-winkel 2 0) (chr 176))
(rtos (caddr ausgang) 2 1))))
ausgang ausgang
) )
(progn (progn
(princ (strcat "\n WARNUNG: KS fehlt in '" blockname "' - verwende Startpunkt")) (princ (ssg-textf "vfe-ks-fehlt-startpunkt" (list blockname)))
startpunkt startpunkt
) )
) )
@@ -355,7 +354,7 @@
(ensure-block-loaded blockname) (ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname)) (if (not (tblsearch "BLOCK" blockname))
(progn (progn
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen")) (princ (ssg-textf "vfe-block-fehlt-abbruch" (list blockname)))
(exit) (exit)
) )
) )
@@ -403,14 +402,14 @@
(setq ausgang (list (+ (car p-aus-rot) (car offset)) (setq ausgang (list (+ (car p-aus-rot) (car offset))
(+ (cadr p-aus-rot) (cadr offset)) (+ (cadr p-aus-rot) (cadr offset))
(+ (caddr p-aus-rot) (caddr offset)))) (+ (caddr p-aus-rot) (caddr offset))))
(princ (strcat "\n HzScaleKS " blockname (princ (ssg-textf "vfe-hz-scaleks-status"
" " (rtos laenge 2 0) "mm" (list blockname (rtos laenge 2 0)
" hz=" (rtos hz-winkel 2 0) (chr 176) (strcat (rtos hz-winkel 2 0) (chr 176))
" -> Z=" (rtos (caddr ausgang) 2 1))) (rtos (caddr ausgang) 2 1))))
ausgang ausgang
) )
(progn (progn
(princ (strcat "\n WARNUNG: KS fehlt in '" blockname "' - verwende Startpunkt")) (princ (ssg-textf "vfe-ks-fehlt-startpunkt" (list blockname)))
startpunkt startpunkt
) )
) )
@@ -432,7 +431,7 @@
(if (not *etage-lib-initialized*) (if (not *etage-lib-initialized*)
(progn (progn
(alert "Etage-Bibliothek nicht initialisiert!") (alert (ssg-text "vfe-alert-bib-nicht-init"))
(exit) (exit)
) )
) )
@@ -452,11 +451,9 @@
(setq schraeg-cos (* (cos schraeg-hz-rad) cos3)) (setq schraeg-cos (* (cos schraeg-hz-rad) cos3))
(princ "\n\n=========================================") (princ "\n\n=========================================")
(princ "\n ETAGE-BERECHNUNG FUER ALLE WINKEL") (princ (ssg-text "vfe-berechnung-header"))
(princ "\n=========================================") (princ "\n=========================================")
(princ (strcat "\n△L=" (rtos deltaL 2 2) " mm" (princ (ssg-textf "vfe-delta-info" (list (rtos deltaL 2 2) (rtos deltaH 2 2) richtung)))
" △H=" (rtos deltaH 2 2) " mm"
" Richtung=" richtung))
(foreach winkel winkel-list (foreach winkel winkel-list
(if (= richtung "Auf") (if (= richtung "Auf")
@@ -471,7 +468,7 @@
) )
(if (or (null mass1) (null mass2)) (if (or (null mass1) (null mass2))
(progn (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)) (setq ergebnis-liste (cons (list winkel nil nil nil) ergebnis-liste))
) )
(progn (progn
@@ -540,9 +537,9 @@
(setq ergebnis-liste (reverse ergebnis-liste)) (setq ergebnis-liste (reverse ergebnis-liste))
(princ "\n\n=================================================================================") (princ "\n\n=================================================================================")
(princ "\n ERGEBNISTABELLE (L_GF = gesamt beider GF-Strecken)") (princ (ssg-text "vfe-ergebnistabelle-header"))
(princ "\n=================================================================================") (princ "\n=================================================================================")
(princ "\n Winkel L_GF (mm) L_VF (mm) Status") (princ (ssg-text "vfe-tabelle-spalten"))
(princ "\n=================================================================================") (princ "\n=================================================================================")
(setq best-winkel nil best-L_GF nil best-L_VF nil) (setq best-winkel nil best-L_GF nil best-L_VF nil)
@@ -553,26 +550,25 @@
gueltig (cadddr item)) gueltig (cadddr item))
(if (and (numberp L_GF) (numberp L_VF)) (if (and (numberp L_GF) (numberp L_VF))
(progn (progn
(princ (strcat "\n " (itoa winkel) (chr 176) (princ (ssg-textf "vfe-tabelle-zeile"
" " (fmt L_GF) " mm " (fmt L_VF) " mm ")) (list (strcat (itoa winkel) (chr 176)) (fmt L_GF) (fmt L_VF))))
(if gueltig (if gueltig
(progn (progn
(princ "GUELTIG") (princ (ssg-text "vfe-status-gueltig"))
(if (or (null best-winkel) (< winkel best-winkel)) (if (or (null best-winkel) (< winkel best-winkel))
(setq best-winkel winkel best-L_GF L_GF best-L_VF L_VF) (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) (princ (ssg-textf "vfe-tabelle-zeile-fehler" (list (strcat (itoa winkel) (chr 176)))))
" --- --- FEHLER"))
) )
) )
(princ "\n=================================================================================") (princ "\n=================================================================================")
(if best-winkel (if best-winkel
(princ (strcat "\n>>> Empfohlener Winkel: " (itoa best-winkel) (chr 176))) (princ (ssg-textf "vfe-empfohlener-winkel" (list (strcat (itoa best-winkel) (chr 176)))))
(princ "\n>>> KEIN passender Winkel gefunden!") (princ (ssg-text "vfe-kein-winkel-gefunden"))
) )
(list best-winkel best-L_GF best-L_VF ergebnis-liste) (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-dx etage-gef-dx-links)
(setq etage-gef-dz etage-gef-dz-links)) (setq etage-gef-dz etage-gef-dz-links))
) )
(princ (strcat "\n Gefaellebogen " seite (princ (ssg-textf "vfe-gefaellebogen-seite-dx" (list seite (rtos etage-gef-dx 2 2))))
": dx=" (rtos etage-gef-dx 2 2) " mm"))
(berechne-winkel-etage deltaL deltaH richtung) (berechne-winkel-etage deltaL deltaH richtung)
) )
@@ -634,41 +629,38 @@
(if (not *etage-lib-initialized*) (init-bibliothek-etage)) (if (not *etage-lib-initialized*) (init-bibliothek-etage))
;; 1. AS_30 ;; 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)) (setq aktueller-punkt (insert-block-by-ks as-block aktueller-punkt 0.0))
;; 2. Staustrecke 400mm (hz-anfang, 3 Grad vert, KS_EIN) ;; 2. Staustrecke 400mm (hz-anfang, 3 Grad vert, KS_EIN)
(princ (strcat "\n\n2/15: Staustrecke 400mm (" (princ (ssg-textf "vfe-step2" (list (itoa hz-anfang))))
(itoa hz-anfang) " Grad hz, 3 Grad vert, KS_EIN)"))
(setq aktueller-punkt (setq aktueller-punkt
(insert-hz-scaled-block-by-ks "Staustrecke_SP_1000_mm" aktueller-punkt (insert-hz-scaled-block-by-ks "Staustrecke_SP_1000_mm" aktueller-punkt
400 hz-anfang 3)) 400 hz-anfang 3))
;; 3. Separator (hz-anfang, 3 Grad vert) ;; 3. Separator (hz-anfang, 3 Grad vert)
(princ (strcat "\n\n3/15: Separator (300mm, " (princ (ssg-textf "vfe-step3" (list (itoa hz-anfang))))
(itoa hz-anfang) " Grad hz, 3 Grad vert)"))
(setq aktueller-punkt (setq aktueller-punkt
(insert-hz-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt (insert-hz-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt
hz-anfang 3 300 0)) hz-anfang 3 300 0))
;; 4. Gefaellebogen Anfang (hz-anfang, 0 Grad vert, KS_EIN) ;; 4. Gefaellebogen Anfang (hz-anfang, 0 Grad vert, KS_EIN)
(princ (strcat "\n\n4/15: " gefaelle-blockname (princ (ssg-textf "vfe-step4" (list gefaelle-blockname (itoa hz-anfang))))
" (Anfang, " (itoa hz-anfang) " Grad hz, 0 Grad vert, KS_EIN)"))
(setq aktueller-punkt (setq aktueller-punkt
(insert-hz-rotated-block-by-ks gefaelle-blockname aktueller-punkt hz-anfang 0)) (insert-hz-rotated-block-by-ks gefaelle-blockname aktueller-punkt hz-anfang 0))
;; 5. L_GF1 (3 Grad geneigt) ;; 5. L_GF1 (3 Grad geneigt)
(if (> L_GF1 0.1) (if (> L_GF1 0.1)
(progn (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 (setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_GF1 3 0.0)) (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) ;; 6. Umlenkstation (3 Grad geneigt)
(princ "\n\n6/15: Umlenkstation (500mm, 3 Grad geneigt)") (princ (ssg-text "vfe-step6"))
(setq aktueller-punkt (setq aktueller-punkt
(insert-rotated-block-with-ks "Vario_Umlenkstation_500mm" aktueller-punkt 3 500 0 0.0)) (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)) (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 (setq aktueller-punkt
(insert-rotated-block-with-ks bogen-name aktueller-punkt 3 bogen-dx bogen-dz 0.0)) (insert-rotated-block-with-ks bogen-name aktueller-punkt 3 bogen-dx bogen-dz 0.0))
@@ -693,22 +685,20 @@
(progn (progn
(if (= richtung "Auf") (if (= richtung "Auf")
(progn (progn
(princ (strcat "\n\n8/15: Steigungsstrecke (" (princ (ssg-textf "vfe-step8-auf" (list (itoa (- (- best-winkel 3))) (rtos L_VF 2 2))))
(itoa (- (- best-winkel 3))) " Grad, L=" (rtos L_VF 2 2) " mm)"))
(setq aktueller-punkt (setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_VF (- (- best-winkel 3)) 0.0)) L_VF (- (- best-winkel 3)) 0.0))
) )
(progn (progn
(princ (strcat "\n\n8/15: Gefaellestrecke (" (princ (ssg-textf "vfe-step8-ab" (list (itoa (+ best-winkel 3)) (rtos L_VF 2 2))))
(itoa (+ best-winkel 3)) " Grad, L=" (rtos L_VF 2 2) " mm)"))
(setq aktueller-punkt (setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_VF (+ best-winkel 3) 0.0)) L_VF (+ best-winkel 3) 0.0))
) )
) )
) )
(princ "\n\n8/15: L_VF (uebersprungen)") (princ (ssg-text "vfe-step8-skip"))
) )
;; 9. 2. Vertikalbogen ;; 9. 2. Vertikalbogen
Lisp/vf_linienzug.lsp
+96 -90
View File
@@ -124,13 +124,13 @@
((= (length gueltige) 1) ((= (length gueltige) 1)
(setq e (car gueltige)) (list (nth 0 e) (nth 1 e) (nth 2 e))) (setq e (car gueltige)) (list (nth 0 e) (nth 1 e) (nth 2 e)))
(t (t
(princ "\n\nMehrere gueltige Winkel - bitte gewuenschten Winkel waehlen:") (princ (ssg-text "vfl-mehrere-winkel-header"))
(setq idx 1) (setq idx 1)
(foreach e gueltige (foreach e gueltige
(princ (strcat "\n " (itoa idx) " - " (itoa (car e)) " Grad" (princ (ssg-textf "vfl-winkel-option"
" (L_GF=" (rtos (cadr e) 2 1) " mm L_VF=" (rtos (caddr e) 2 1) " mm)")) (list idx (car e) (rtos (cadr e) 2 1) (rtos (caddr e) 2 1))))
(setq idx (1+ idx))) (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)) (if (or (null antwort) (< antwort 1) (> antwort (length gueltige))) (setq antwort 1))
(setq e (nth (1- antwort) gueltige)) (setq e (nth (1- antwort) gueltige))
(list (nth 0 e) (nth 1 e) (nth 2 e))))) (list (nth 0 e) (nth 1 e) (nth 2 e)))))
@@ -275,8 +275,7 @@
(defun vfl-20m-check (p-umlenk p-akt / laenge) (defun vfl-20m-check (p-umlenk p-akt / laenge)
(setq laenge (vfl-planar-dist p-umlenk p-akt)) (setq laenge (vfl-planar-dist p-umlenk p-akt))
(if (> laenge 20000.0) (if (> laenge 20000.0)
(princ (strcat "\n >>> HINWEIS: Foerderer laenger als 20 m (" (princ (ssg-textf "vfl-20m-hinweis" (list (rtos (/ laenge 1000.0) 2 2))))
(rtos (/ laenge 1000.0) 2 2) " m) - Motorstation empfohlen!"))
) )
) )
@@ -299,7 +298,7 @@
;; horizontale Stueck, wo der Separator in der 0-Grad-Ebene liegt (NICHT auf der ;; horizontale Stueck, wo der Separator in der 0-Grad-Ebene liegt (NICHT auf der
;; 3-Grad-Basis wie vfl-insert-separator). Rueckgabe: Endpunkt. ;; 3-Grad-Basis wie vfl-insert-separator). Rueckgabe: Endpunkt.
(defun vfl-sep-hz (pt hz / ep) (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 ep (gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm" pt hz 0 300 0))
(setq *vfl-acc-separator* (1+ *vfl-acc-separator*)) (setq *vfl-acc-separator* (1+ *vfl-acc-separator*))
ep) ep)
@@ -314,7 +313,7 @@
(progn (progn
(setq hz (car (frame->hz-winkel frame))) (setq hz (car (frame->hz-winkel frame)))
(setq m (get-bogen-mass bogen-ab 3)) (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) (setq pt (insert-rotated-block-with-ks "Vario_Bogen_ab_3" (car frame)
0 (car m) (caddr m) hz)) 0 (car m) (caddr m) hz))
(vfl-frame-3grad pt hz)) (vfl-frame-3grad pt hz))
@@ -328,26 +327,28 @@
;; VOR/NACH liegen in der 0-Grad-Ebene. Rueckgabe: neuer Frame (flach, 0 Grad). ;; 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) (defun vfl-baue-horizontal-koerper (frame hz dL / pt m1 sep-vor)
(setq pt (car frame)) (setq pt (car frame))
(princ "\n\nZusaetzlichen Separator VOR dem horizontalen Stueck?") (princ (ssg-text "vfl-sep-vor-frage"))
(princ "\n 1 - Ja\n 2 - Nein") (princ (ssg-text "vfl-ja"))
(setq sep-vor (= (getstring "\nIhre Wahl (1/2) [2]: ") "1")) (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) ;; auf_3-Eintritt nur, wenn noch NICHT flach (sonst flache Zone fortsetzen)
(if (not (vfl-frame-flach-p frame)) (if (not (vfl-frame-flach-p frame))
(progn (progn
(setq m1 (get-bogen-mass bogen-auf 3)) (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 (setq pt (insert-rotated-block-with-ks "Vario_Bogen_auf_3" pt
(ssg-cfg-or "vario" "gefaelle_winkel" 3) (car m1) (caddr m1) hz)))) (ssg-cfg-or "vario" "gefaelle_winkel" 3) (car m1) (caddr m1) hz))))
;; optionaler Separator VOR - in der horizontalen Ebene (0 Grad) ;; optionaler Separator VOR - in der horizontalen Ebene (0 Grad)
(if sep-vor (setq pt (vfl-sep-hz pt hz))) (if sep-vor (setq pt (vfl-sep-hz pt hz)))
;; horizontale Zwischenstrecke (0 Grad) ;; 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)) (setq pt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" pt dL 0 hz))
(vfl-acc-vf-seg "horizontal" 0 dL) (vfl-acc-vf-seg "horizontal" 0 dL)
;; optionaler Separator NACH - ebenfalls horizontal (0 Grad) ;; optionaler Separator NACH - ebenfalls horizontal (0 Grad)
(princ "\n\nZusaetzlichen Separator NACH dem horizontalen Stueck?") (princ (ssg-text "vfl-sep-nach-frage"))
(princ "\n 1 - Ja\n 2 - Nein") (princ (ssg-text "vfl-ja"))
(if (= (getstring "\nIhre Wahl (1/2) [2]: ") "1") (setq pt (vfl-sep-hz pt hz))) (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) ;; KEIN ab_3 mehr -> das Stueck ENDET FLACH (0 Grad)
(make-frame-from-dir pt (hz-winkel->xu hz 0.0)) (make-frame-from-dir pt (hz-winkel->xu hz 0.0))
) )
@@ -429,24 +430,23 @@
(setq frame (vfl-nach-3grad frame)) (setq frame (vfl-nach-3grad frame))
(setq linie-mess (vfl-neue-linie-messen (car frame) letzt-hz)) (setq linie-mess (vfl-neue-linie-messen (car frame) letzt-hz))
(if (null linie-mess) (if (null linie-mess)
(progn (princ "\n Abgebrochen - kein Zielpunkt gewaehlt.") nil) (progn (princ (ssg-text "vfl-abgebrochen-kein-ziel")) nil)
(progn (progn
(setq dL (car linie-mess) hzn (cadr linie-mess)) (setq dL (car linie-mess) hzn (cadr linie-mess))
(setq hn (getreal (strcat "\nHoehe (Z) des Kettenendes (ES-Element) [" (setq hn (getreal (ssg-textf "vfl-prompt-hoehe-kettenende"
(rtos (caddr (car frame)) 2 1) "]: "))) (list (rtos (caddr (car frame)) 2 1)))))
(if (null hn) (setq hn (caddr (car frame)))) (if (null hn) (setq hn (caddr (car frame))))
(setq dH (- hn (caddr (car frame)))) (setq dH (- hn (caddr (car frame))))
(setq richtn (if (>= dH 0.0) "Auf" "Ab")) (setq richtn (if (>= dH 0.0) "Auf" "Ab"))
(setq dH (abs dH)) (setq dH (abs dH))
(setq rad3 (* (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)) (/ pi 180.0))) (setq rad3 (* (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)) (/ pi 180.0)))
(princ (strcat "\n>>> Kettenende-Modus: Ziel dL=" (rtos dL 2 0) (princ (ssg-textf "vfl-kettenende-modus-ziel"
" mm, dH=" (rtos dH 2 0) " mm (" richtn "). GF2 variiert mit dem Winkel.")) (list (rtos dL 2 0) (rtos dH 2 0) richtn)))
(setq dec (vfl-body-zerlegung dL dH 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)) (setq typ (nth 0 dec) w (nth 1 dec) lgf (nth 2 dec) lvf (nth 3 dec))
(if (null typ) (if (null typ)
(progn (progn
(princ (strcat "\n FEHLER: Rest nicht baubar (zu steil/zu kurz fuer" (princ (ssg-text "vfl-fehler-rest-nicht-baubar"))
" Schwanz Motor+GF2+Separator+ES). Bitte weiter zeichnen oder flacher planen."))
nil) nil)
(progn (progn
;; Soll-ES-Punkt fuer den Ist-Ziel-Report merken (Startpunkt + ;; Soll-ES-Punkt fuer den Ist-Ziel-Report merken (Startpunkt +
@@ -474,9 +474,8 @@
(t 0.0))) (t 0.0)))
(if (and (> gf2 0.0) (< gf2 *vfl-gf-min-laenge*)) (if (and (> gf2 0.0) (< gf2 *vfl-gf-min-laenge*))
(progn (progn
(princ (strcat "\n HINWEIS: berechnetes GF2=" (rtos gf2 2 0) (princ (ssg-textf "vfl-hinweis-gf2-minimum"
" mm < Minimum " (rtos *vfl-gf-min-laenge* 2 0) (list (rtos gf2 2 0) (rtos *vfl-gf-min-laenge* 2 0))))
" mm -> auf Minimum angehoben (ES endet dadurch etwas weiter; siehe Ist-Ziel-Report)."))
(setq gf2 *vfl-gf-min-laenge*))) (setq gf2 *vfl-gf-min-laenge*)))
(list frame cnt hzn gf2) (list frame cnt hzn gf2)
) )
@@ -518,11 +517,11 @@
;; --- Fortsetzungs-Schleife bis Foerderer-Ende --- ;; --- Fortsetzungs-Schleife bis Foerderer-Ende ---
(setq fertig nil) (setq fertig nil)
(while (not fertig) (while (not fertig)
(princ "\n\nIst der Endpunkt der Foerderer?") (princ (ssg-text "vfl-ist-endpunkt-frage"))
(princ "\n 1 - Ja (nur Motorstation setzen)") (princ (ssg-text "vfl-ja-nur-motorstation"))
(princ "\n 2 - Nein (weiterbauen)") (princ (ssg-text "vfl-nein-weiterbauen"))
(princ "\n 3 - Ja (Motorstation setzen, Kettenende definieren)") (princ (ssg-text "vfl-ja-motorstation-kettenende"))
(setq antwort (getstring "\nIhre Wahl (1/2/3) [2]: ")) (setq antwort (getstring (ssg-text "vfl-prompt-wahl-1-3-def2")))
(if (= antwort "1") (if (= antwort "1")
(setq fertig t) (setq fertig t)
(if (= antwort "3") (if (= antwort "3")
@@ -537,11 +536,11 @@
ziel-ende t ziel-ende t
fertig t))) fertig t)))
(progn (progn
(princ "\n\nNaechstes Element im VarioFoerderer:") (princ (ssg-text "vfl-naechstes-element-vf"))
(princ "\n 1 - Horizontaler Foerderer (Linie ohne Hoehendifferenz)") (princ (ssg-text "vfl-opt-horizontaler-foerderer"))
(princ "\n 2 - Vario-Kurve (30/60/90 Grad)") (princ (ssg-text "vfl-opt-vario-kurve"))
(princ "\n 3 - Auf/Ab-Foerderer (Linie mit Hoehendifferenz)") (princ (ssg-text "vfl-opt-auf-ab-foerderer"))
(setq antwort (getstring "\nIhre Wahl (1/2/3) [3]: ")) (setq antwort (getstring (ssg-text "vfl-prompt-wahl-1-3-def3")))
(cond (cond
;; --- Vario-Kurve (aendert hz) --- ;; --- Vario-Kurve (aendert hz) ---
((= antwort "2") ((= antwort "2")
@@ -561,7 +560,7 @@
(setq vf-count (1+ vf-count) letzt-hz hzn) (setq vf-count (1+ vf-count) letzt-hz hzn)
(vfl-20m-check p-umlenk (car frame)) (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)) (setq dL (car linie-mess) hzn (cadr linie-mess))
(if (> dL 1.0) (if (> dL 1.0)
(progn (progn
(setq hn (getreal (strcat "\nHoehe (Z) des Endpunkts [" (setq hn (getreal (ssg-textf "vfl-prompt-hoehe-endpunkt"
(rtos (caddr (car frame)) 2 1) "]: "))) (list (rtos (caddr (car frame)) 2 1)))))
(if (null hn) (setq hn (caddr (car frame)))) (if (null hn) (setq hn (caddr (car frame))))
(setq dH (- hn (caddr (car frame)))) (setq dH (- hn (caddr (car frame))))
(setq richtn (if (>= dH 0.0) "Auf" "Ab")) (setq richtn (if (>= dH 0.0) "Auf" "Ab"))
@@ -591,12 +590,10 @@
(vfl-acc-vf-seg richtn w lvf) (vfl-acc-vf-seg richtn w lvf)
(vfl-20m-check p-umlenk (car frame)) (vfl-20m-check p-umlenk (car frame))
) )
(princ (strcat "\n Segment waere GF (zu steil) oder nicht baubar - " (princ (ssg-text "vfl-segment-gf-nicht-erlaubt"))
"innerhalb einer VF-Einheit nicht erlaubt.\n"
" Bitte flacher/steigend zeichnen oder Foerderer beenden."))
) )
) )
(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). ;; GF-Bogen (horizontale Kurve, Neigung bleibt wie im aktuellen Frame).
;; Fragt Winkel (30/60/90) und Seite interaktiv ab. ;; Fragt Winkel (30/60/90) und Seite interaktiv ab.
(defun vfl-insert-gf-bogen (frame / bwinkel bseite antwort blockname) (defun vfl-insert-gf-bogen (frame / bwinkel bseite antwort blockname)
(princ "\n\nGF-Bogen - Winkel waehlen:") (princ (ssg-text "vfl-gf-bogen-winkel-header"))
(princ "\n 1 - 30 Grad\n 2 - 60 Grad\n 3 - 90 Grad") (princ (ssg-text "vfl-winkel-30"))
(setq antwort (getint "\nIhre Wahl (1/2/3) [3]: ")) (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)) (if (null antwort) (setq antwort 3))
(setq bwinkel (cond ((= antwort 1) 30) ((= antwort 2) 60) (t 90))) (setq bwinkel (cond ((= antwort 1) 30) ((= antwort 2) 60) (t 90)))
(princ "\nGF-Bogen - Seite waehlen:") (princ (ssg-text "vfl-gf-bogen-seite-header"))
(princ "\n 1 - Links\n 2 - Rechts") (princ (ssg-text "gf-seite-links"))
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: ")) (princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(setq bseite (if (= antwort "2") "rechts" "links")) (setq bseite (if (= antwort "2") "rechts" "links"))
(setq blockname (gf-bogen-blockname bwinkel bseite)) (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 ;; GF-Bogen zaehlen (Seite L/R + Winkel) -> Attribut GF_Bogen_L/R_xx
(setq *vfl-acc-gfbogen* (setq *vfl-acc-gfbogen*
(vfl-inc-count *vfl-acc-gfbogen* (vfl-inc-count *vfl-acc-gfbogen*
@@ -657,21 +657,25 @@
;; extract-ks-from-block-raw normalisiert das (siehe ks-normalize-name). ;; extract-ks-from-block-raw normalisiert das (siehe ks-normalize-name).
(defun vfl-insert-vario-kurve (frame / kwinkel kseite kvariante antwort blockname (defun vfl-insert-vario-kurve (frame / kwinkel kseite kvariante antwort blockname
hz flach-frame) hz flach-frame)
(princ "\n\nVario-Kurve - Winkel waehlen:") (princ (ssg-text "vfl-variokurve-winkel-header"))
(princ "\n 1 - 90 Grad\n 2 - 60 Grad\n 3 - 30 Grad") (princ (ssg-text "vfl-opt1-90grad"))
(setq antwort (getint "\nIhre Wahl (1/2/3) [1]: ")) (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)) (if (null antwort) (setq antwort 1))
(setq kwinkel (cond ((= antwort 1) 90) ((= antwort 2) 60) (t 30))) (setq kwinkel (cond ((= antwort 1) 90) ((= antwort 2) 60) (t 30)))
(princ "\nVario-Kurve - Seite waehlen:") (princ (ssg-text "vfl-variokurve-seite-header"))
(princ "\n 1 - Links\n 2 - Rechts") (princ (ssg-text "gf-seite-links"))
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: ")) (princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(setq kseite (if (= antwort "2") "rechts" "links")) (setq kseite (if (= antwort "2") "rechts" "links"))
(princ "\nVario-Kurve - Variante waehlen:") (princ (ssg-text "vfl-variokurve-variante-header"))
(princ "\n 1 - Aussen\n 2 - Innen") (princ (ssg-text "vfl-variante-aussen"))
(setq antwort (getstring "\nIhre Wahl (1/2) [2]: ")) (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 kvariante (if (= antwort "1") "aussen" "innen"))
(setq blockname (vfl-kurve-blockname kwinkel kseite kvariante)) (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 ;; Vario-Kurve zaehlen (Variante A=aussen/I=innen + Winkel) -> VF_Bogen_A/I_xx
(setq *vfl-acc-variokurve* (setq *vfl-acc-variokurve*
(vfl-inc-count *vfl-acc-variokurve* (vfl-inc-count *vfl-acc-variokurve*
@@ -714,9 +718,10 @@
;; ES-Seite erst am Kettenende abfragen (Links/Rechts). ;; ES-Seite erst am Kettenende abfragen (Links/Rechts).
(defun vfl-frage-es-seite ( / antwort) (defun vfl-frage-es-seite ( / antwort)
(princ "\n\nEIN-Element (ES_Element_90_*) - Seite waehlen:") (princ (ssg-text "gf-seite-ein-header"))
(princ "\n 1 - Links\n 2 - Rechts") (princ (ssg-text "gf-seite-links"))
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: ")) (princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(if (= antwort "2") "rechts" "links") (if (= antwort "2") "rechts" "links")
) )
@@ -836,7 +841,7 @@
;; Aufsteigende, eindeutige ID vergeben (wie beim Kreisel), falls verfuegbar. ;; Aufsteigende, eindeutige ID vergeben (wie beim Kreisel), falls verfuegbar.
(if (car (atoms-family 1 '("SSG-ID-GENERATE"))) (if (car (atoms-family 1 '("SSG-ID-GENERATE")))
(ssg-id-generate vfl-insert)) (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 vfl-insert
) )
@@ -850,10 +855,10 @@
(defun vfl-vf-einheit-abschluss (frame hz richtung winkel L_GF L_VF auto-ende / (defun vfl-vf-einheit-abschluss (frame hz richtung winkel L_GF L_VF auto-ende /
antwort res es-s ende) antwort res es-s ende)
;; GF-Verteilung: halbe Staustrecke am Ausgang (GF2) oder alles am Einlauf. ;; GF-Verteilung: halbe Staustrecke am Ausgang (GF2) oder alles am Einlauf.
(princ "\n\nStaustrecke (GF) - Verteilung waehlen:") (princ (ssg-text "vfl-gf-verteilung-header"))
(princ "\n 1 - 1/2GF am Ausgang (GF2), 1/2GF am Einlauf (GF1)") (princ (ssg-text "vfl-gf-verteilung-haelfte"))
(princ "\n 2 - Gesamte Staustrecke am Einlauf (GF1), kein GF2") (princ (ssg-text "vfl-gf-verteilung-ganz-einlauf"))
(setq antwort (getstring "\nIhre Wahl (1/2) [2]: ")) (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 res (vfl-vf-einheit frame hz richtung winkel L_GF L_VF (= antwort "1")))
(setq frame (nth 0 res)) (setq frame (nth 0 res))
;; Kettenende? Bei auto-ende (Kettenende-Modus) ohne Frage direkt ES setzen. ;; Kettenende? Bei auto-ende (Kettenende-Modus) ohne Frage direkt ES setzen.
@@ -863,10 +868,10 @@
(if (or auto-ende (nth 2 res)) (if (or auto-ende (nth 2 res))
(setq antwort "1") (setq antwort "1")
(progn (progn
(princ "\n\nIst das das Kettenende (ES-Element)?") (princ (ssg-text "vfl-ist-kettenende-frage"))
(princ "\n 1 - Ja (Separator + ES-Element setzen)") (princ (ssg-text "vfl-ja-separator-es"))
(princ "\n 2 - Nein (weiterbauen)") (princ (ssg-text "vfl-nein-weiterbauen"))
(setq antwort (getstring "\nIhre Wahl (1/2) [2]: ")) (setq antwort (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")))
) )
) )
(if (= antwort "1") (if (= antwort "1")
@@ -879,25 +884,28 @@
;; Ist-Ziel-Report (Option 3): Soll-ES (aus vfl-body-abschluss) vs. Ist-ES. ;; Ist-Ziel-Report (Option 3): Soll-ES (aus vfl-body-abschluss) vs. Ist-ES.
(if *vfl-ziel-punkt* (if *vfl-ziel-punkt*
(progn (progn
(princ "\n\n>>> IST-ZIEL-VERGLEICH (ES-Element):") (princ (ssg-text "vfl-ist-ziel-vergleich-header"))
(princ (strcat "\n Soll: X=" (rtos (car *vfl-ziel-punkt*) 2 1) (princ (ssg-textf "vfl-soll-xyz"
" Y=" (rtos (cadr *vfl-ziel-punkt*) 2 1) (list (rtos (car *vfl-ziel-punkt*) 2 1)
" Z=" (rtos (caddr *vfl-ziel-punkt*) 2 1))) (rtos (cadr *vfl-ziel-punkt*) 2 1)
(princ (strcat "\n Ist : X=" (rtos (car (car frame)) 2 1) (rtos (caddr *vfl-ziel-punkt*) 2 1))))
" Y=" (rtos (cadr (car frame)) 2 1) (princ (ssg-textf "vfl-ist-xyz"
" Z=" (rtos (caddr (car frame)) 2 1))) (list (rtos (car (car frame)) 2 1)
(princ (strcat "\n Abweichung: dX=" (rtos (cadr (car frame)) 2 1)
(rtos (- (car (car frame)) (car *vfl-ziel-punkt*)) 2 1) (rtos (caddr (car frame)) 2 1))))
" dY=" (rtos (- (cadr (car frame)) (cadr *vfl-ziel-punkt*)) 2 1) (princ (ssg-textf "vfl-abweichung-xyz"
" dZ=" (rtos (- (caddr (car frame)) (caddr *vfl-ziel-punkt*)) 2 1) " mm")) (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) (setq *vfl-ziel-punkt* nil)
) )
) )
) )
(progn (progn
(princ "\n\nZusaetzlichen Separator an dieser Stelle einfuegen?") (princ (ssg-text "vfl-sep-an-stelle-frage"))
(princ "\n 1 - Ja\n 2 - Nein") (princ (ssg-text "vfl-ja"))
(setq antwort (getstring "\nIhre Wahl (1/2) [2]: ")) (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))) (if (= antwort "1") (setq frame (vfl-insert-separator frame)))
) )
) )
@@ -913,11 +921,9 @@
frame letzter-typ fertig linie-ende-modus rad3 frame letzter-typ fertig linie-ende-modus rad3
anzahl-gf anzahl-vf vfl-nummer lastEnt) anzahl-gf anzahl-vf vfl-nummer lastEnt)
(princ "\n\n=========================================") (princ "\n\n=========================================")
(princ "\n VF-LINIENZUG - Modus 1: Manuelle Eingabe") (princ (ssg-text "vfl-modus1-header"))
(princ "\n=========================================") (princ "\n=========================================")
(princ "\nGemischte Gefaellestrecke/VarioFoerderer-Kette entlang eines frei") (princ (ssg-text "vfl-modus1-beschreibung"))
(princ "\ngezeichneten Pfades. Kette beginnt immer mit AS_Element, endet immer")
(princ "\nmit ES_Element.")
;; Abhaengigkeit: die GF-Segmente/-Boegen nutzen Funktionen aus ;; Abhaengigkeit: die GF-Segmente/-Boegen nutzen Funktionen aus
;; Gefaellestrecke.lsp (gf-insert-hz-incl-scaled, gf-bogen-blockname, ...). ;; 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* (if *vf-std-core-pfad*
(load (strcat *vf-std-core-pfad* "/vf_core.lsp")) (load (strcat *vf-std-core-pfad* "/vf_core.lsp"))
(progn (progn
(princ "\n[vf_standard] WARNUNG: Lisp-Pfad nicht ermittelbar - vf_core.lsp nicht ladbar!") (princ (ssg-text "vfs-warn-lisppfad"))
(exit) (exit)
) )
) )
@@ -77,10 +77,10 @@
) )
(if missing (if missing
(progn (progn
(princ (strcat "\n FEHLER: DXFM_BLOCKS = " block-pfad)) (princ (ssg-textf "vfs-block-fehler-pfad" (list block-pfad)))
(princ "\n Folgende Block-Dateien fehlen:") (princ (ssg-text "vfs-block-fehlende-header"))
(foreach f (reverse missing) (foreach f (reverse missing)
(princ (strcat "\n - " f)) (princ (ssg-textf "vfs-block-fehlende-item" (list f)))
) )
nil nil
) )
@@ -101,7 +101,7 @@
(if (and *lib-initialized* bogen-auf bogen-ab (if (and *lib-initialized* bogen-auf bogen-ab
(tblsearch "BLOCK" "AS_Element_90_links")) (tblsearch "BLOCK" "AS_Element_90_links"))
(progn (progn
(princ "\n Standard-Bibliothek bereits initialisiert.") (princ (ssg-text "vfs-lib-bereits-init"))
t t
) )
(if (not (vf-check-required-blocks)) (if (not (vf-check-required-blocks))
@@ -109,10 +109,10 @@
(progn (progn
(setq *lib-initialized* nil) (setq *lib-initialized* nil)
(setq *ks-cache* nil) (setq *ks-cache* nil)
(princ "\n Initialisiere Standard-Bibliothek...") (princ (ssg-text "vfs-lib-init-start"))
;; AS_90 Masse extrahieren ;; 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_links")
(ensure-block-loaded "AS_Element_90_rechts") (ensure-block-loaded "AS_Element_90_rechts")
(if (tblsearch "BLOCK" "AS_Element_90_links") (if (tblsearch "BLOCK" "AS_Element_90_links")
@@ -132,17 +132,16 @@
(setq aus-dx (- (caar ks-aus-pos) (caar ks-ein-pos))) (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-dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos))))
(setq aus-dz (- (caddr (car ks-aus-pos)) (caddr (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) (princ (ssg-textf "vfs-as90-mass" (list (rtos aus-dx 2 0) (rtos aus-dz 2 0))))
" dz=" (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 ;; 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_links")
(ensure-block-loaded "ES_Element_90_rechts") (ensure-block-loaded "ES_Element_90_rechts")
(if (tblsearch "BLOCK" "ES_Element_90_links") (if (tblsearch "BLOCK" "ES_Element_90_links")
@@ -162,17 +161,16 @@
(setq ein-dx (- (caar ks-aus-pos) (caar ks-ein-pos))) (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-dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos))))
(setq ein-dz (- (caddr (car ks-aus-pos)) (caddr (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) (princ (ssg-textf "vfs-es90-mass" (list (rtos ein-dx 2 0) (rtos ein-dz 2 0))))
" dz=" (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 ;; Bogen-Masse extrahieren
(princ "\n Extrahiere Bogen-Masse...") (princ (ssg-text "vfs-extrahiere-bogen"))
(setq bogen-auf '()) (setq bogen-auf '())
(setq bogen-ab '()) (setq bogen-ab '())
(setq bogen-winkel (ssg-cfg-or "vario" "bogen_winkel" (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 dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos))))
(setq dz (- (caddr (car ks-aus-pos)) (caddr (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)) (setq bogen-auf (cons (list w dx dy dz) bogen-auf))
(princ (strcat "\n OK auf_" (itoa w) (princ (ssg-textf "vfs-bogen-auf-ok" (list (itoa w) (rtos dx 2 0) (rtos dz 2 0))))
": dx=" (rtos dx 2 0) " dz=" (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 ;; Abwaertsbogen
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa w))) (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 dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos))))
(setq dz (- (caddr (car ks-aus-pos)) (caddr (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)) (setq bogen-ab (cons (list w dx dy dz) bogen-ab))
(princ (strcat "\n OK ab_" (itoa w) (princ (ssg-textf "vfs-bogen-ab-ok" (list (itoa w) (rtos dx 2 0) (rtos dz 2 0))))
": dx=" (rtos dx 2 0) " dz=" (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-auf (reverse bogen-auf))
(setq bogen-ab (reverse bogen-ab)) (setq bogen-ab (reverse bogen-ab))
(setq *lib-initialized* t) (setq *lib-initialized* t)
(princ "\n Standard-Bibliothek erfolgreich initialisiert.") (princ (ssg-text "vfs-lib-init-erfolg"))
t t
) ;; end progn (Initialisierung) ) ;; end progn (Initialisierung)
) ;; end (if not vf-check-required-blocks) ) ;; end (if not vf-check-required-blocks)
@@ -254,8 +250,7 @@
(if (= (car item) winkel) (setq result (cdr item))) (if (= (car item) winkel) (setq result (cdr item)))
) )
(if (null result) (if (null result)
(princ (strcat "\n FEHLER: Winkel " (itoa winkel) (princ (ssg-textf "vfs-fehler-winkel-tabelle" (list (itoa winkel))))
" nicht in Bogen-Tabelle!"))
) )
result result
) )
@@ -276,7 +271,7 @@
(if (or (not *lib-initialized*) (null aus-dz) (null ein-dz)) (if (or (not *lib-initialized*) (null aus-dz) (null ein-dz))
(progn (progn
(princ "\n FEHLER: Bibliothek nicht korrekt initialisiert (AUS/EIN-Masse fehlen)!") (princ (ssg-text "vfs-fehler-lib-nicht-init"))
(exit) (exit)
) )
) )
@@ -290,11 +285,10 @@
sin3 (sin (* (ssg-cfg-or "vario" "gefaelle_winkel" 3) (/ pi 180.0)))) sin3 (sin (* (ssg-cfg-or "vario" "gefaelle_winkel" 3) (/ pi 180.0))))
(princ "\n\n=========================================") (princ "\n\n=========================================")
(princ "\n BERECHNUNG FUER ALLE WINKEL (Standard)") (princ (ssg-text "vfs-berechnung-header"))
(princ "\n=========================================") (princ "\n=========================================")
(princ (strcat "\n△L=" (rtos deltaL 2 2) " mm" (princ (ssg-textf "vfs-berechnung-parameter"
" △H=" (rtos deltaH 2 2) " mm" (list (rtos deltaL 2 2) (rtos deltaH 2 2) richtung)))
" Richtung=" richtung))
(foreach winkel winkel-list (foreach winkel winkel-list
(if (= richtung "Auf") (if (= richtung "Auf")
@@ -357,9 +351,9 @@
(setq ergebnis-liste (reverse ergebnis-liste)) (setq ergebnis-liste (reverse ergebnis-liste))
(princ "\n\n=================================================================================") (princ "\n\n=================================================================================")
(princ "\n ERGEBNISTABELLE") (princ (ssg-text "vfs-ergebnistabelle-header"))
(princ "\n=================================================================================") (princ "\n=================================================================================")
(princ "\n Winkel L_GF (mm) L_VF (mm) Status") (princ (ssg-text "vfs-tabelle-spalten"))
(princ "\n=================================================================================") (princ "\n=================================================================================")
(setq best-winkel nil best-L_GF nil best-L_VF nil) (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)) (setq winkel (car item) L_GF (cadr item) L_VF (caddr item) gueltig (cadddr item))
(if (and (numberp L_GF) (numberp L_VF)) (if (and (numberp L_GF) (numberp L_VF))
(progn (progn
(princ (strcat "\n " (itoa winkel) (chr 176) (princ (ssg-textf "vfs-tabelle-zeile"
" " (fmt L_GF) " mm " (fmt L_VF) " mm ")) (list (itoa winkel) (chr 176) (fmt L_GF) (fmt L_VF))))
(if gueltig (if gueltig
(progn (progn
(princ "GUELTIG") (princ (ssg-text "vfs-status-gueltig"))
(if (or (null best-winkel) (< winkel best-winkel)) (if (or (null best-winkel) (< winkel best-winkel))
(setq best-winkel winkel best-L_GF L_GF best-L_VF L_VF) (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) (princ (ssg-textf "vfs-tabelle-zeile-fehler" (list (itoa winkel) (chr 176))))
" --- --- FEHLER"))
) )
) )
(princ "\n=================================================================================") (princ "\n=================================================================================")
(if best-winkel (if best-winkel
(princ (strcat "\n>>> Empfohlener Winkel: " (itoa best-winkel) (chr 176))) (princ (ssg-textf "vfs-empfohlener-winkel" (list (itoa best-winkel) (chr 176))))
(princ "\n>>> KEIN passender Winkel gefunden!") (princ (ssg-text "vfs-kein-winkel-gefunden"))
) )
(list best-winkel best-L_GF best-L_VF ergebnis-liste) (list best-winkel best-L_GF best-L_VF ergebnis-liste)
) )
@@ -471,7 +464,7 @@
(setq hz (float hz)) (setq hz (float hz))
(setq as-block (strcat "AS_Element_90_" seite)) (setq as-block (strcat "AS_Element_90_" seite))
(if (not *lib-initialized*) (init-bibliothek)) (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) (insert-block-by-ks as-block startpunkt hz)
) )
@@ -485,22 +478,22 @@
;; 1. Gefaellestrecke GF1 (verbindet AS-Neigung mit Umlenkstation) ;; 1. Gefaellestrecke GF1 (verbindet AS-Neigung mit Umlenkstation)
(if (> L_GF1 0.1) (if (> L_GF1 0.1)
(progn (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 (setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_GF1 (ssg-cfg-or "vario" "gefaelle_winkel" 3) hz)) 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) ;; 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 (setq aktueller-punkt
(insert-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" 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" "gefaelle_winkel" 3)
(ssg-cfg-or "vario" "separator_block_dx" 300) (ssg-cfg-or "vario" "separator_block_dx" 300)
(ssg-cfg-or "vario" "separator_block_dz" 0) hz)) (ssg-cfg-or "vario" "separator_block_dz" 0) hz))
;; 3. Umlenkstation ;; 3. Umlenkstation
(princ "\n[VF-Eingang] Umlenkstation (500 mm, 3 Grad geneigt)") (princ (ssg-text "vfs-vf-eingang-umlenk"))
(setq aktueller-punkt (setq aktueller-punkt
(insert-rotated-block-with-ks "Vario_Umlenkstation_500mm" aktueller-punkt (insert-rotated-block-with-ks "Vario_Umlenkstation_500mm" aktueller-punkt
(ssg-cfg-or "vario" "gefaelle_winkel" 3) (ssg-cfg-or "vario" "gefaelle_winkel" 3)
@@ -542,7 +535,7 @@
) )
) )
(setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass)) (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 (setq aktueller-punkt
(insert-rotated-block-with-ks bogen-name aktueller-punkt (insert-rotated-block-with-ks bogen-name aktueller-punkt
(ssg-cfg-or "vario" "gefaelle_winkel" 3) bogen-dx bogen-dz hz)) (ssg-cfg-or "vario" "gefaelle_winkel" 3) bogen-dx bogen-dz hz))