Compare commits

..

59 Commits

Author SHA1 Message Date
y.wang 21daab974d Merge branch 'master' of https://gitea.schoenenberger.de/Schoenenberger_Systeme_GmbH/dxfmakros 2026-07-20 16:50:14 +02:00
y.wang 8efdbc0c5f keys de/en für VF-linienzug wurde eingefügt, Export Sivas ruft vorab ZAEHLE_SEP_SCAN auf(Attribute aktualisieren), Menü neu laden notwendig 2026-07-20 16:49:59 +02:00
m.stangl 903e086e7f Bezeichnung statt Name bei ILS KReisel und Eckrad verwendet. Eigene Spalte für Bezeichnung im Sivas Export dazu gebaut 2026-07-20 16:46:16 +02:00
m.stangl d4ea049918 Merge branch 'master' of https://gitea.schoenenberger.de/Schoenenberger_Systeme_GmbH/dxfmakros 2026-07-20 15:39:22 +02:00
m.stangl 5c28db9e91 Oberfläche für Standard von Varioförder und Gefällestrecke bauen lassen 2026-07-20 15:39:17 +02:00
m.stangl 27ab8b4875 altes Symbol rausgeworfen 2026-07-20 15:12:52 +02:00
y.wang 297bb8b905 Menueeintraege Scanner/Separator einfuegen + Zaehlbefehl im Zusatzmodul; Einfuege-Befehle ILS_SCANNER_INSERT/ILS_SEPARATOR_INSTERT 2026-07-20 14:43:59 +02:00
y.wang 4971af8617 Merge branch 'master' of https://gitea.schoenenberger.de/Schoenenberger_Systeme_GmbH/dxfmakros 2026-07-20 14:15:49 +02:00
y.wang 2acbd1e989 die KS_AUS von 30° AS_Element wurde korrigiert. 2026-07-20 14:15:42 +02:00
s.hensch 15f57e7c32 Merge branch 'master' of https://gitea.schoenenberger.de/Schoenenberger_Systeme_GmbH/dxfmakros 2026-07-20 14:14:41 +02:00
s.hensch 4bec8d92bd [ADD] Funktionen und Menü zum Hinzufügen von Omniflo TEF Bauteilen integriert 2026-07-20 14:14:35 +02:00
y.wang 6e8f4c75fe Merge origin/master: i18n-System (de/en) + 30-Grad-AS/ES-Elemente zusammenfuehren
Lokaler Stand (Modus-3 Randwert-Solver, 30/90-AS/ES, Kreisel-Attribute)
mit dem Remote-Stand (Internationalisierung ssg-text, neue Bloecke,
Sivas-Export) vereint.

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

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

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-07-20 14:08:13 +02:00
y.wang bc09b23c23 Überprfüng Funktion für Anzahl der Separatoren und Scanner wurde gebaut 2026-07-20 13:06:50 +02:00
y.wang 57a9f09898 Attribut-Tags umbenannt: N_SEPARATOREN → ANZAHL_SEPARATOR, N_SCANNER → ANZAHL_SCANNER 2026-07-20 13:04:47 +02:00
y.wang f38b06ddf5 VF-Linienzug Modus 2 (Ziel-Hoehe) fertig , AS/ES 30/90 Grad bei GF und VF waehlbar. 2026-07-20 12:59:09 +02:00
y.wang c20c35411a Die KS-AUS von 30° AS_ELemente wurde korrigiert. 2026-07-20 12:49:32 +02:00
m.stangl a56ddb5e6c Attribute des Kreisels werden beim Sivas Export in anderer Reihenfolge rausgeschrieben 2026-07-20 09:49:20 +02:00
m.stangl 7941a792e0 Reihenfolge des Sivas CSV Exports geändert 2026-07-20 09:45:11 +02:00
s.hensch adfde744e2 [FIX] Beim Einfügen eines Blocks wird die Farbe des Layers nur noch neu gesetzt, wenn der Layer noch nicht existiert 2026-07-20 08:43:08 +02:00
s.hensch 2d6fd86d37 [ADD] LISP Skript zum Erstellen einer JSON-Datei mit allen DWG-Blöcken und deren Attributen eines Verzeichnisses und Skript zum Schreiben von Attributen aus einer JSON auf die Blöcke in einem Verzeichnis entsprechend des Dateinamens 2026-07-20 07:47:18 +02:00
m.stangl e2aee8c413 neue Omniflo Referenz 2026-07-18 20:17:36 +02:00
m.stangl 6d5cecd6a1 test_foerderer: TeileArt-Erwartung an aktuelles export_csv.py angleichen
test_vario_teileart erwartete noch "VarioFoerderer", obwohl export_csv.py
seit Commit bf51747 (14 Commits zuvor) bewusst "ILS 2.0 Strecke" liefert -
ein VarioFoerderer ist ein Streckentyp. Test war seither stale, unabhaengig
von den foerderer_tests.json-Aenderungen dieser Session.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2026-07-17 22:27:32 +02:00
m.stangl f6635ef217 Neue Referenzdaten für den Förderer eingepflegt, da jetzt auch verschiedene Varianten im Test laufen können. 2026-07-17 18:44:13 +02:00
m.stangl 1c43a5301b TEST_FOERDERER: Seite, Winkel und GF-Verteilung ueber foerderer_tests.json steuerbar
Bisher waren Seite (links/rechts), ein erzwungener Rampenwinkel und die
Aufteilung der Gefaelle-Laenge auf Ein-/Auslauf im Testtreiber hart codiert
(immer "links", automatischer Winkel, 50/50-Split). Alle drei Werte sind
bereits als Parameter/Rueckgabewerte in vf_standard.lsp/vf_core.lsp
vorhanden - keine Aenderung an produktivem LISP-Code noetig, nur am
Testtreiber und der Testdatei.

Neue optionale JSON-Felder: seite, winkel, gf_verteilung (gleichmaessig/
vorne/hinten). Bestehende 12 Testfaelle bleiben unveraendert und
verhalten sich dank Default-Fallbacks identisch zu vorher.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2026-07-17 17:33:18 +02:00
m.stangl db75a25ae1 Sivas-Export: Gefaellestrecke und VarioFoerderer mit Detail-Zeilen statt Sammelzeile
Gefaellestrecke (GF_N): je Zeile eine Gruppe gleichartiger Bloecke (gleiche
Hoehe/Laenge/Winkel/Separatoren/Scanner/Typ), IDs und Bezeichnung als Array
statt einer einzigen Sammelzeile mit reiner Anzahl.

VarioFoerderer (VF_N): je Compound-Block eine eigene Zeile mit vollstaendigen
Gefaelle-/Angetrieben-Teilgruppen (Laengen, Winkel, Kurven, Foerderrichtung),
da VF_N immer TYP "Streckengruppe" ist. Lose Strecke-Elemente ausserhalb
eines VF_N-Blocks bleiben weiterhin in einer gruppierten IDs-Zeile.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2026-07-17 14:09:26 +02:00
s.hensch 18a2172d4f [FIX] Attribute der DWG Blöcke mit UTF-8 formatiert und Umlaute und Sonderzeichen (°) entfernt bzw ersetzt, zB ä->ae 2026-07-17 12:41:34 +02:00
s.hensch 659aa8e8c1 [FIX] JSON Parser in Lisp konnte keine leeren JSON Attribut-Objekte behandeln (Kurve:{}) und hat einen Fehler geworfen. Dieses Verhalten wurde nun korrigiert 2026-07-17 12:39:22 +02:00
s.hensch d3ad4f8c5e [ADD] Modulweichen-Blöcke hinzugefügt für die spätere dynamische Erzeugung anhand der Weichensituationen - Diese Blöcke sind keine Dummy-Weichenelemente für die TOS Kalkulation 2026-07-17 10:42:21 +02:00
m.stangl bd1366bc8a Uebersetzung der Benutzermeldungen in vf_core.lsp und Gefaellestrecke.lsp auf ssg-text/ssg-textf umgestellt
Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2026-07-16 09:39:18 +02:00
m.stangl 9199ea705f Werkzeug zur Extraktion der Begriffe aus den Lisp Files mit eingecheckt 2026-07-15 23:48:33 +02:00
m.stangl cfdcd31b30 Sprachen als .json Datei in lang Ordner gelegt 2026-07-15 23:47:20 +02:00
m.stangl 78f19c750c Merge branch 'master' of https://gitea.schoenenberger.de/Schoenenberger_Systeme_GmbH/dxfmakros 2026-07-15 21:25:49 +02:00
m.stangl 2eca169326 Uebersetzung aller Benutzermeldungen auf ssg-text/ssg-textf umgestellt
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>
2026-07-15 21:24:18 +02:00
s.hensch 1ddd9449c6 Merge branch 'master' of https://gitea.schoenenberger.de/Schoenenberger_Systeme_GmbH/dxfmakros 2026-07-15 16:02:04 +02:00
s.hensch 3ab7d29476 [FIX] Korrektur und Ergänzung der Attribute und deren Werte in den Blockdateien für ILS und Omniflo 2026-07-15 16:01:49 +02:00
m.stangl 15ba546a17 Übersetzungsdatei dazu 2026-07-15 15:18:08 +02:00
m.stangl 9458382965 Sprachumschaltung von DE nach EN über Menü möglich gemacht 2026-07-15 15:11:02 +02:00
m.stangl 0fe14c5454 Was bei Übersetzung zu tun wäre 2026-07-14 16:36:25 +02:00
m.stangl bf517475bb ILS Elementtypen für den Export hinzugefügt. 2026-07-14 16:25:21 +02:00
m.stangl ae9ce69d5f Doku der ausgegrauten Menüs 2026-07-14 14:45:24 +02:00
m.stangl 2ae64cb4a8 Menüs ausgegraut die nur Dummyroutinen aufrufen 2026-07-14 14:44:24 +02:00
y.wang 8e5db27730 3D-Blöcke für Motorstation und Umlenkstation links/rechts wurden eingepflegt. 2026-07-14 14:03:20 +02:00
y.wang 73603ea55b Linienzug-Testeingaben nach linienzug_tests.json auslagern + in alltests.json und run-all integrieren 2026-07-14 14:00:53 +02:00
m.stangl a9c03b0b9a BT MT Beladung als .dwg eingecheckt 2026-07-13 11:56:33 +02:00
m.stangl ab7fc92e23 Ausgabeverzeichnis nur über Lisp Variable festlegen. Anscheinend speichert Bricscad Umgebungen über die Sessions hinweg. Die Ausgaben der Tests landen woanders als der generelle Export 2026-07-10 21:26:41 +02:00
m.stangl bde2380490 Merge branch 'master' of https://gitea.schoenenberger.de/Schoenenberger_Systeme_GmbH/dxfmakros 2026-07-10 21:22:53 +02:00
m.stangl 2767897158 Aufruf von explizitem Python Call rausgeworfen. War nur zu testzwecken 2026-07-10 20:16:46 +02:00
s.hensch 444d643dd3 [ADD] Attribute für ILS 2d/3d ergänzt und neu angeordnet 2026-07-10 14:16:30 +02:00
m.stangl 554e9bee99 Format der SivasNummer ohne + 2026-07-10 13:34:10 +02:00
m.stangl fe283a0bf3 ABP 60 und APB 100 als eigenes AUswahlkriterium in die Oberfläche der 90Grad Bögen hinzugefügt. Beide APB60 Bögen und die Sternweiche dazu 2026-07-10 13:32:52 +02:00
m.stangl 6bf6b00e13 neue APB 60 Bögen dazu 2026-07-10 13:31:18 +02:00
m.stangl f7933df5a4 Attribute mit SKript angeordnet. Test des Einfügens 2026-07-10 11:17:11 +02:00
m.stangl 0b89ed6c5e Dispogruppe-Header korrigiert, Container-Referenzen und --type 2D/3D fuer set_attributs.py
Sivasnr-Werte mit 0_BGxxxxxx-Mustern werden jetzt ueber die neue
[container]-Config-Sektion in kommaseparierte Listen aufgeloest.
set_attributs.py kann nun explizit zwischen data/omniflo/2D und /3D
als Quellverzeichnis waehlen.
2026-07-09 16:03:22 +02:00
m.stangl 335c6d7875 erste FAssung der reference Dateien dazu 2026-07-09 16:01:12 +02:00
s.hensch 8a7521572d Merge branch 'master' of https://gitea.schoenenberger.de/m.stangl/dxfmakros 2026-07-09 15:44:08 +02:00
s.hensch 1d3191b84b [ADD] Staustrecke Gerade mit Vario links/rechts 3D hinzugefügt 2026-07-09 15:43:58 +02:00
y.wang 6073eb1d78 Merge branch 'master' of https://gitea.schoenenberger.de/Schoenenberger_Systeme_GmbH/dxfmakros 2026-07-09 10:59:00 +02:00
y.wang 96788e7244 TEST_LINIENZUG in eigene tests/test_linienzug.lsp auslagern + eigenen Menuepunkt Foerderer-Linienzug anlegen (Foerderer-Eintrag zurueckgesetzt), Menü neu laden nötig, damit Foerderer-Linienzug in Menü erscheint. 2026-07-09 10:58:56 +02:00
s.hensch 72a4637bd2 [CHANGE] Attribute für ARTINR und SIVASNR_TEF zu kommaseparierter liste geändert für vereinheitlichung; Unnötige dxf-Dateien entfernt oder umbenannt 2026-07-09 10:41:11 +02:00
336 changed files with 268625 additions and 454797 deletions
+13 -7
View File
@@ -67,11 +67,12 @@ Die `start_briscad.bat` ruft `setenv.bat` auf und startet BricsCAD.
|---|---|---| |---|---|---|
| Kreisel-Module | `KreiselInsert` | KreiselInsert, KreiselConnect, KreiselEdit, ILS_Eckrad | | Kreisel-Module | `KreiselInsert` | KreiselInsert, KreiselConnect, KreiselEdit, ILS_Eckrad |
| Zusatzmodul/Foerderer/Kurven | `SSG_LIB_Commands` | ILS_BTMT_*, ILS_ETF_*, ILS_K*_*, ILS_GK*_* | | Zusatzmodul/Foerderer/Kurven | `SSG_LIB_Commands` | ILS_BTMT_*, ILS_ETF_*, ILS_K*_*, ILS_GK*_* |
| VarioFoerderer | `VarioFoerderer` | FOERDERANLAGE | | VarioFoerderer | `VarioFoerderer` | FOERDERANLAGE, VARIOFOERDERER_EDIT |
| Gefaellestrecke | `Gefaellestrecke` | GEFAELLESTRECKE | | Gefaellestrecke | `Gefaellestrecke` | GEFAELLESTRECKE, GEFAELLESTRECKE_EDIT |
| Omniflo (komplett) | `OmniModulInsert` | OMNI_APB_*, OMNI_W*_*, OMNI_AP*, OMNI_TEF_*, OMNI_TV_*, OMNI_EDIT | | Omniflo (komplett) | `OmniModulInsert` | OMNI_APB_*, OMNI_W*_*, OMNI_AP*, OMNI_TEF_*, OMNI_TV_*, OMNI_EDIT |
| Export | `export` | EXPORTSIVAS, EXPORTCSV, CALLPYTHON | | Export | `export` | EXPORTSIVAS, EXPORTCSV, CALLPYTHON |
| Doppelklick/Kontextmenue | `SSG_LIB_Commands` | SSG_BLOCKEDIT | | Konfiguration | `SSG_LIB_Commands` | SSG_DIM_SWITCH, SSG_SPRACHE |
| Doppelklick/Kontextmenue | `SSG_LIB_Commands` | SSG_BLOCKEDIT (dispatcht Kreisel->KreiselEdit, Omniflo->OMNI_EDIT, GF_*->GEFAELLESTRECKE_EDIT, VF_*->VARIOFOERDERER_EDIT) |
### Entfernte Legacy-Dateien ### Entfernte Legacy-Dateien
@@ -86,15 +87,16 @@ Detaillierte Dokumentation aller Funktionen und Befehle: siehe `Lisp/README.md`.
| Datei | Befehle | Beschreibung | | Datei | Befehle | Beschreibung |
|---|---|---| |---|---|---|
| `ssg_core.lsp` | - | Kernel: ssg-start/ssg-end, ssg-cfg-or, ssg-attrib-read/write, Layer/Block-Ops | | `ssg_core.lsp` | - | Kernel: ssg-start/ssg-end, ssg-cfg-or, ssg-attrib-read/write, Layer/Block-Ops |
| `ssg_lang.lsp` | - | Sprachumschaltung Deutsch/Englisch (ssg-text, ssg-textf, *ssg-lang*) |
| `ssg_dbg.lsp` | - | Debug-Logging (dbgopen, dbgmsg, dbgflush, dbgclose) | | `ssg_dbg.lsp` | - | Debug-Logging (dbgopen, dbgmsg, dbgflush, dbgclose) |
| `ssg_dialog.lsp` | - | DCL-Dialog-Vorlagen und Hilfsfunktionen | | `ssg_dialog.lsp` | - | DCL-Dialog-Vorlagen und Hilfsfunktionen |
| `ssg_layer.lsp` | - | Layer-Verwaltung | | `ssg_layer.lsp` | - | Layer-Verwaltung |
| `KreiselInsert.lsp` | KreiselInsert, KreiselConnect, KreiselRedraw, KreiselQuick, KreiselEdit, KreiselParams, KreiselLabelSetup, KreiselLabelPos, KreiselLabelHoehe, ILS_Eckrad | ILS Kreisel und Eckrad komplett in AutoLISP | | `KreiselInsert.lsp` | KreiselInsert, KreiselConnect, KreiselRedraw, KreiselQuick, KreiselEdit, KreiselParams, KreiselLabelSetup, KreiselLabelPos, KreiselLabelHoehe, ILS_Eckrad | ILS Kreisel und Eckrad komplett in AutoLISP |
| `VarioFoerderer.lsp` | FOERDERANLAGE | Vario-Foerderanlagen Generator | | `VarioFoerderer.lsp` (Wrapper fuer `vf_core.lsp`/`vf_standard.lsp`/`vf_etage.lsp`/`vf_linienzug.lsp`) | FOERDERANLAGE, VARIOFOERDERER_EDIT | Vario-Foerderanlagen Generator (Typen Standard/Etage/Linienzug); Standardfall + Werteingabe per DCL-Dialog (`vfs-standard-dialog-ablauf` in vf_standard.lsp); Doppelklick auf VF_n-Block ruft VARIOFOERDERER_EDIT (nur fuer per Dialog erstellte Standard-Bloecke, erkannt an XDATA) |
| `Gefaellestrecke.lsp` | GEFAELLESTRECKE | Gefaelle-Foerderanlage (AUS -> Staustrecke skaliert -> Separator -> EIN) | | `Gefaellestrecke.lsp` | GEFAELLESTRECKE, GEFAELLESTRECKE_EDIT | Gefaelle-Foerderanlage (AUS -> Staustrecke skaliert -> Separator -> EIN); Modus 1 per DCL-Dialog (Einfuegehoehe, Element-Winkel 30/90); Doppelklick auf GF_n-Block ruft GEFAELLESTRECKE_EDIT (Dialog vorbelegt, Neuaufbau) |
| `export.lsp` | EXPORTSIVAS, EXPORTCSV, OMNI_UPDATE_ATTRIBS | JSON-Sammlung und Python-Export (Omniflo-Merkmale/Sum-Zeile via lib/export_csv.py) | | `export.lsp` | EXPORTSIVAS, EXPORTCSV, OMNI_UPDATE_ATTRIBS | JSON-Sammlung und Python-Export (Omniflo-Merkmale/Sum-Zeile via lib/export_csv.py) |
| `OmniModulInsert.lsp` | OMNI_LOAD, OMNI_APB_*, OMNI_W*_*, OMNI_AP60/AP110, OMNI_TEF_*, OMNI_TV_*, OMNI_APBW_*, OMNI_EDIT | Omniflo-Komponenten: Boegen, Weichen, Verbinder, Transferwagen, Edit-Dialog | | `OmniModulInsert.lsp` | OMNI_LOAD, OMNI_APB_*, OMNI_W*_*, OMNI_AP60/AP110, OMNI_TEF_*, OMNI_TV_*, OMNI_APBW_*, OMNI_EDIT | Omniflo-Komponenten: Boegen, Weichen, Verbinder, Transferwagen, Edit-Dialog |
| `SSG_LIB_Commands.lsp` | ILS_BTMT_*, ILS_ETF_*, ILS_K*_*, ILS_GK*_*, SSG_BLOCKEDIT | Dummy-Befehle fuer Menue + Doppelklick/Kontextmenue-Dispatcher | | `SSG_LIB_Commands.lsp` | ILS_BTMT_*, ILS_ETF_*, ILS_K*_*, ILS_GK*_*, SSG_BLOCKEDIT, SSG_DIM_SWITCH, SSG_SPRACHE | Dummy-Befehle fuer Menue + Doppelklick/Kontextmenue-Dispatcher + Konfiguration (2D/3D, Sprache) |
| `menu-inventory.lsp` | MenuInventory | BricsCAD Diagnostik (Menuegruppen, Plugins, Startdateien) | | `menu-inventory.lsp` | MenuInventory | BricsCAD Diagnostik (Menuegruppen, Plugins, Startdateien) |
## DCL-Dialoge ## DCL-Dialoge
@@ -102,15 +104,18 @@ Detaillierte Dokumentation aller Funktionen und Befehle: siehe `Lisp/README.md`.
| Datei | Verwendet von | | Datei | Verwendet von |
|---|---| |---|---|
| `kreisel_edit.dcl` | KreiselEdit (KreiselInsert.lsp) | | `kreisel_edit.dcl` | KreiselEdit (KreiselInsert.lsp) |
| `gefaellestrecke.dcl` | GEFAELLESTRECKE Modus 1 (Gefaellestrecke.lsp, `gf-dialog-eingabe`) |
| `variofoerderer.dcl` | FOERDERANLAGE Standardfall + Werteingabe (vf_standard.lsp, `vfs-dialog-eingabe-basis`/`vfs-dialog-winkel-verteilung`) |
| `omniflo_boegen.dcl` | OMNI_APB_* (OmniModulInsert.lsp) | | `omniflo_boegen.dcl` | OMNI_APB_* (OmniModulInsert.lsp) |
| `omniflo_weichen.dcl` | OMNI_W*_* (OmniModulInsert.lsp) | | `omniflo_weichen.dcl` | OMNI_W*_* (OmniModulInsert.lsp) |
| `sprache.dcl` | SSG_SPRACHE (SSG_LIB_Commands.lsp) |
## Menue (SSG_LIB.mnu + SSG_LIB.mnl) ## Menue (SSG_LIB.mnu + SSG_LIB.mnl)
- `SSG_LIB.mnu` - Menuedefinition mit Lazy-Loading (`(ssg-ensure "Modul") Befehl`) - `SSG_LIB.mnu` - Menuedefinition mit Lazy-Loading (`(ssg-ensure "Modul") Befehl`)
- `SSG_LIB.mnl` - Automatisch geladen mit dem Menue, definiert `ssg-ensure` Loader - `SSG_LIB.mnl` - Automatisch geladen mit dem Menue, definiert `ssg-ensure` Loader
- `***MENUGROUP=SSG_LIB` - Menuegruppenname - `***MENUGROUP=SSG_LIB` - Menuegruppenname
- `***POP1` - Hauptmenue (ILS, Omniflo, Export) - `***POP1` - Hauptmenue (ILS, Omniflo, Export, Konfiguration)
- `***DOUBLECLICK` - Doppelklick auf INSERT-Bloecke ruft SSG_BLOCKEDIT auf - `***DOUBLECLICK` - Doppelklick auf INSERT-Bloecke ruft SSG_BLOCKEDIT auf
- `***POP501` - Rechtsklick-Kontextmenue (KreiselEdit, OMNI_EDIT, SSG_BLOCKEDIT) - `***POP501` - Rechtsklick-Kontextmenue (KreiselEdit, OMNI_EDIT, SSG_BLOCKEDIT)
@@ -124,6 +129,7 @@ Werden via `bin/setenv.bat` gesetzt. Wichtigste:
- `DXFM_LOG` - Log-Verzeichnis - `DXFM_LOG` - Log-Verzeichnis
- `DXFM_DCL` - Pfad zu DCL-Dialogdateien - `DXFM_DCL` - Pfad zu DCL-Dialogdateien
- `DXFM_CFG` - Konfigurationsverzeichnis - `DXFM_CFG` - Konfigurationsverzeichnis
- `DXFM_LANG` - Aktive Sprache (`de_DE`/`en_GB`), persistiert von `SSG_SPRACHE`; Default `de_DE`
## Konventionen ## Konventionen
+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"))
) )
+564 -268
View File
File diff suppressed because it is too large Load Diff
+120 -129
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"))
) )
) )
) )
@@ -72,12 +72,12 @@
;; Attribut-Definitionen: ((TAG DEFAULT) ...) ;; Attribut-Definitionen: ((TAG DEFAULT) ...)
(setq *kreisel-attrib-defs* (setq *kreisel-attrib-defs*
'(("NAME" "") '(("Bezeichnung" "")
("DREHRICHTUNG" "UZS") ("DREHRICHTUNG" "UZS")
("N_SEPARATOREN" "2") ("ANZAHL_SEPARATOR" "2")
("KREISELART" "STANDARD") ("KREISELART" "STANDARD")
("N_SCANNER" "0") ("ANZAHL_SCANNER" "0")
("N_RAMPEN" "0") ("N_RAMPEN" "0")
("DREHUNG" "0") ("DREHUNG" "0")
("ABSTAND" "2300") ("ABSTAND" "2300")
("NUMMER" "0") ("NUMMER" "0")
@@ -90,7 +90,7 @@
;; Eckrad Attribut-Definitionen: ((TAG DEFAULT) ...) ;; Eckrad Attribut-Definitionen: ((TAG DEFAULT) ...)
(setq *eckrad-attrib-defs* (setq *eckrad-attrib-defs*
'(("NAME" "") '(("Bezeichnung" "")
("DREHRICHTUNG" "UZS") ("DREHRICHTUNG" "UZS")
("DREHUNG" "0") ("DREHUNG" "0")
("NUMMER" "0") ("NUMMER" "0")
@@ -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"))
@@ -325,9 +325,9 @@
) )
) )
;; NAME automatisch setzen: "KreiselN" ;; Bezeichnung automatisch setzen: "KreiselN"
(setq attribs (subst (cons "NAME" (strcat "Kreisel" (itoa kreisel-nummer))) (setq attribs (subst (cons "Bezeichnung" (strcat "Kreisel" (itoa kreisel-nummer)))
(assoc "NAME" attribs) attribs)) (assoc "Bezeichnung" attribs) attribs))
;; --- HÖHE BESTIMMEN --- ;; --- HÖHE BESTIMMEN ---
;; Priorität 1: Aus basePoint (wenn 3D Punkt mit Z > 0) ;; Priorität 1: Aus basePoint (wenn 3D Punkt mit Z > 0)
@@ -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,41 +545,39 @@
(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*))
) )
) )
;; 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))
) )
;; 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
@@ -933,7 +928,7 @@
) )
;; Tiles initialisieren ;; Tiles initialisieren
(set_tile "name" (cdr (assoc "NAME" attribs))) (set_tile "name" (cdr (assoc "Bezeichnung" attribs)))
(set_tile "abstand" (cdr (assoc "ABSTAND" attribs))) (set_tile "abstand" (cdr (assoc "ABSTAND" attribs)))
(set_tile "hoehe" (cdr (assoc "HOEHE" attribs))) (set_tile "hoehe" (cdr (assoc "HOEHE" attribs)))
@@ -981,8 +976,8 @@
(setq newRotation (kreisel-idx-to-rotation (atoi dlg-ausrichtung))) (setq newRotation (kreisel-idx-to-rotation (atoi dlg-ausrichtung)))
;; Attribute aktualisieren ;; Attribute aktualisieren
(setq attribs (subst (cons "NAME" dlg-name) (setq attribs (subst (cons "Bezeichnung" dlg-name)
(assoc "NAME" attribs) attribs)) (assoc "Bezeichnung" attribs) attribs))
(setq attribs (subst (cons "HOEHE" dlg-hoehe) (setq attribs (subst (cons "HOEHE" dlg-hoehe)
(assoc "HOEHE" attribs) attribs)) (assoc "HOEHE" attribs) attribs))
(setq attribs (subst (cons "KREISELART" (setq attribs (subst (cons "KREISELART"
@@ -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)
) )
+149 -99
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)))
) )
) )
) )
@@ -326,11 +326,13 @@
;; --- Bogen-Auswahl-Dialog oeffnen --- ;; --- Bogen-Auswahl-Dialog oeffnen ---
;; winkel = KurvenWinkel (90, 67.5, 45, 22.5, 180) ;; winkel = KurvenWinkel (90, 67.5, 45, 22.5, 180)
;; init-hoehe / init-drehung = Vorbelegung (optional, fuer Edit-Modus) ;; init-hoehe / init-drehung = Vorbelegung (optional, fuer Edit-Modus)
;; profiltyp = optionales Praefix zum Filtern des ProfilTyp-Textes,
;; z.B. "APB 60" oder "APB 110" (nil = keine Einschraenkung)
;; Rueckgabe: (eintrag hoehe drehung) oder nil bei Abbruch ;; Rueckgabe: (eintrag hoehe drehung) oder nil bei Abbruch
(defun omni:bogen-dialog (winkel init-hoehe init-drehung / dcl-pfad dat boegen-liste (defun omni:bogen-dialog (winkel init-hoehe init-drehung profiltyp / dcl-pfad dat boegen-liste
profil-liste ergebnis dlg-hoehe dlg-drehung) profil-liste ergebnis dlg-hoehe dlg-drehung profil)
(if (null *OMNI-BOEGEN*) (omni:load-data)) (if (null *OMNI-BOEGEN*) (omni:load-data))
;; Defaults ;; Defaults
@@ -339,11 +341,31 @@
;; Boegen nach Winkel filtern ;; Boegen nach Winkel filtern
(setq boegen-liste (omni:filter *OMNI-BOEGEN* "KurvenWinkel" winkel)) (setq boegen-liste (omni:filter *OMNI-BOEGEN* "KurvenWinkel" winkel))
;; Optional zusaetzlich nach ProfilTyp-Praefix filtern (z.B. "APB 60")
(if profiltyp
(setq boegen-liste
(vl-remove-if-not
'(lambda (e)
(setq profil (cdr (assoc "ProfilTyp" e)))
(and profil (= (vl-string-search profiltyp profil) 0))
)
boegen-liste
)
)
)
(if (null boegen-liste) (if (null boegen-liste)
(progn (progn
(alert (strcat "Keine Boegen fuer " (alert (ssg-textf "omni-bogen-keine-gefunden"
(if (= (type winkel) 'INT) (itoa winkel) (rtos winkel 2 1)) (list
" Grad gefunden.")) (strcat
(if (= (type winkel) 'INT) (itoa winkel) (rtos winkel 2 1))
(ssg-text "omni-grad")
)
(if profiltyp (strcat " (" profiltyp ")") "")
)
))
nil nil
) )
(progn (progn
@@ -358,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")
@@ -405,47 +427,57 @@
;; ============================================================ ;; ============================================================
;; --- Omniflo / Boegen --- ;; --- Omniflo / Boegen ---
(defun c:OMNI_APB_630_90 ( / dlg-result) (defun c:OMNI_APB60_90 ( / dlg-result)
(setq dlg-result (omni:bogen-dialog 90 nil nil)) (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)
)
(defun c:OMNI_APB_630_90 ( / dlg-result)
(setq dlg-result (omni:bogen-dialog 90 nil nil "APB 110"))
(if dlg-result
(omni:insert-from-entry dlg-result)
(princ (ssg-text "omni-abbruch-bogen"))
) )
(princ) (princ)
) )
(defun c:OMNI_APB_550_675 ( / dlg-result) (defun c:OMNI_APB_550_675 ( / dlg-result)
(setq dlg-result (omni:bogen-dialog 67.5 nil nil)) (setq dlg-result (omni:bogen-dialog 67.5 nil nil nil))
(if dlg-result (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)
) )
(defun c:OMNI_APB_630_45 ( / dlg-result) (defun c:OMNI_APB_630_45 ( / dlg-result)
(setq dlg-result (omni:bogen-dialog 45 nil nil)) (setq dlg-result (omni:bogen-dialog 45 nil nil nil))
(if dlg-result (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)
) )
(defun c:OMNI_APB_550_225 ( / dlg-result) (defun c:OMNI_APB_550_225 ( / dlg-result)
(setq dlg-result (omni:bogen-dialog 22.5 nil nil)) (setq dlg-result (omni:bogen-dialog 22.5 nil nil nil))
(if dlg-result (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)
) )
(defun c:OMNI_APB_650_180 ( / dlg-result) (defun c:OMNI_APB_650_180 ( / dlg-result)
(setq dlg-result (omni:bogen-dialog 180 nil nil)) (setq dlg-result (omni:bogen-dialog 180 nil nil nil))
(if dlg-result (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)
) )
@@ -485,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)
@@ -493,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)
@@ -515,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))
@@ -604,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)
) )
) )
@@ -756,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"
(cond (list
((null winkel) "alle Winkel") (cond
((= (type winkel) 'INT) (strcat (itoa winkel) " Grad")) ((null winkel) (ssg-text "omni-alle-winkel"))
(T (strcat (rtos winkel 2 1) " Grad")) ((= (type winkel) 'INT) (strcat (itoa winkel) (ssg-text "omni-grad")))
(T (strcat (rtos winkel 2 1) (ssg-text "omni-grad")))
)
(if weichentyp (strcat " / " weichentyp) "")
) )
(if weichentyp (strcat " / " weichentyp) "") ))
" gefunden."))
nil nil
) )
(progn (progn
@@ -779,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")
@@ -840,31 +872,41 @@
;; hoehe = Hoehe in mm als String (wird als HOEHE-Attribut gesetzt) ;; hoehe = Hoehe in mm als String (wird als HOEHE-Attribut gesetzt)
;; drehung = Drehwinkel in Grad als String (Block-Rotation) ;; drehung = Drehwinkel in Grad als String (Block-Rotation)
;; Rueckgabe: Einfuegepunkt oder nil bei Abbruch ;; Rueckgabe: Einfuegepunkt oder nil bei Abbruch
(defun omni:insert-dxf (sivasnr-str hoehe drehung / dxf-pfad omniflo-pfad pt angleDeg blockEnt attribs layer-name) (defun omni:insert-dxf (sivasnr-str hoehe drehung / dxf-pfad omniflo-pfad pt angleDeg winkel-rad drehung-anzeige blockEnt attribs layer-name)
(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)
(setvar "ATTDIA" 0) (setvar "ATTDIA" 0)
;; Drehwinkel aus Dialog verwenden ;; Drehwinkel aus Dialog uebernehmen, sonst interaktiv am Einfuegepunkt abfragen
(setq angleDeg (if drehung (atof drehung) 0.0)) (if drehung
(progn
(setq angleDeg (atof drehung))
(setq drehung-anzeige drehung)
)
(progn
(setq winkel-rad (getangle pt (ssg-text "omni-prompt-drehwinkel")))
(setq angleDeg (if winkel-rad (* winkel-rad (/ 180.0 pi)) 0.0))
(setq drehung-anzeige (rtos angleDeg 2 1))
)
)
;; Hoehe als Z-Koordinate auf den Einfuegepunkt anwenden ;; Hoehe als Z-Koordinate auf den Einfuegepunkt anwenden
(if (and hoehe (/= hoehe "")) (if (and hoehe (/= hoehe ""))
@@ -884,7 +926,7 @@
;; HOEHE und DREHUNG Attribute setzen ;; HOEHE und DREHUNG Attribute setzen
(ssg-attrib-set-on blockEnt (ssg-attrib-set-on blockEnt
(list (cons "HOEHE" (if hoehe hoehe (ssg-cfg-or "omniflo" "default_hoehe" "2000"))) (list (cons "HOEHE" (if hoehe hoehe (ssg-cfg-or "omniflo" "default_hoehe" "2000")))
(cons "DREHUNG" (if drehung drehung (ssg-cfg-or "omniflo" "default_drehung" "0"))))) (cons "DREHUNG" drehung-anzeige)))
;; Layer aus LAYER-Attribut lesen und Block verschieben ;; Layer aus LAYER-Attribut lesen und Block verschieben
(setq attribs (ssg-attrib-read blockEnt)) (setq attribs (ssg-attrib-read blockEnt))
@@ -904,10 +946,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"))
drehung-anzeige
(if layer-name (strcat " Layer=" layer-name) "")
)))
(ssg-end) (ssg-end)
pt pt
) )
@@ -928,8 +973,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)
) )
) )
@@ -945,7 +990,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)
) )
@@ -954,7 +999,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)
) )
@@ -963,7 +1008,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)
) )
@@ -973,7 +1018,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)
) )
@@ -982,7 +1027,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)
) )
@@ -991,7 +1036,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)
) )
@@ -1001,7 +1046,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)
) )
@@ -1010,7 +1055,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)
) )
@@ -1019,7 +1064,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)
) )
@@ -1029,7 +1074,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)
) )
@@ -1038,7 +1083,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)
) )
@@ -1047,7 +1092,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)
) )
@@ -1057,7 +1102,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)
) )
@@ -1066,7 +1111,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)
) )
@@ -1096,7 +1141,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)))
) )
) )
@@ -1104,7 +1149,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
@@ -1160,7 +1205,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)
) )
@@ -1171,7 +1216,7 @@
(if (= typ "bogen") (if (= typ "bogen")
(progn (progn
(setq winkel (cdr (assoc "KurvenWinkel" eintrag))) (setq winkel (cdr (assoc "KurvenWinkel" eintrag)))
(setq dlg-result (omni:bogen-dialog winkel hoehe drehung)) (setq dlg-result (omni:bogen-dialog winkel hoehe drehung nil))
) )
(progn (progn
(setq winkel (cdr (assoc "KurvenWinkel" eintrag))) (setq winkel (cdr (assoc "KurvenWinkel" eintrag)))
@@ -1181,7 +1226,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
@@ -1194,7 +1239,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)
) )
@@ -1223,9 +1268,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)
@@ -1233,28 +1281,30 @@
;; --- Omniflo / TEF Elemente --- ;; --- Omniflo / TEF Elemente ---
;; Feste TEF-Bauteile ohne Sivas-Auswahl: Datei liegt direkt unter DXFM_OMNIFLO,
;; wird per omni:insert-dxf am gewaehlten Einfuegepunkt ohne Drehung eingefuegt.
(defun c:OMNI_TEF_UmlenkR () (defun c:OMNI_TEF_UmlenkR ()
(princ "\n[DUMMY] Umlenkspannst. rechts fuer TEF links") (omni:insert-dxf "Umlenkspannst_TEF_rechts" nil nil)
(princ) (princ)
) )
(defun c:OMNI_TEF_UmlenkL () (defun c:OMNI_TEF_UmlenkL ()
(princ "\n[DUMMY] Umlenkspannst. links fuer TEF rechts") (omni:insert-dxf "Umlenkspannst_TEF_links" nil nil)
(princ) (princ)
) )
(defun c:OMNI_TEF_AntriebL () (defun c:OMNI_TEF_AntriebL ()
(princ "\n[DUMMY] Antriebst. links fuer TEF links") (omni:insert-dxf "0_B10010" nil nil)
(princ) (princ)
) )
(defun c:OMNI_TEF_AntriebR () (defun c:OMNI_TEF_AntriebR ()
(princ "\n[DUMMY] Antriebst. rechts fuer TEF rechts") (omni:insert-dxf "0_B10020" nil nil)
(princ) (princ)
) )
(defun c:OMNI_TEF_Gerade () (defun c:OMNI_TEF_Gerade ()
(princ "\n[DUMMY] TEF Gerade") (omni:insert-dxf "0_B10030" nil nil)
(princ) (princ)
) )
+116 -9
View File
@@ -15,7 +15,7 @@ _MENULOAD → menu/SSG_LIB.mnu auswaehlen
``` ```
BricsCAD laedt daraufhin automatisch `SSG_LIB.mnl`, welches alle Module BricsCAD laedt daraufhin automatisch `SSG_LIB.mnl`, welches alle Module
per `ssg-ensure` initialisiert (Kern: ssg_core/dbg/dialog/layer, dann per `ssg-ensure` initialisiert (Kern: ssg_core/lang/dbg/dialog/layer, dann
alle Feature-Module). Details: siehe `../CLAUDE.md` Abschnitt "Lademechanismus". alle Feature-Module). Details: siehe `../CLAUDE.md` Abschnitt "Lademechanismus".
**Manuell laden (Notfall / Entwicklung):** **Manuell laden (Notfall / Entwicklung):**
@@ -26,6 +26,28 @@ alle Feature-Module). Details: siehe `../CLAUDE.md` Abschnitt "Lademechanismus".
--- ---
## Status: noch offene Menueintraege (im Menue ausgegraut)
Die folgenden Menueintraege rufen aktuell nur eine Dummy-Funktion auf (Meldung
`[DUMMY]`, keine Geometrie). Sie sind in `menu/SSG_LIB.mnu` mit `~` **ausgegraut**
und werden erst bei echter Implementierung wieder aktiviert. Der `~`-Marker steht
am Label-Anfang, bei Submenue-Schliessern hinter dem `<-` (`[<-~Label]`).
| Menuebereich | Eintraege | Definiert in |
| --- | --- | --- |
| ILS ▸ Zusatzmodul | BTMT-Beladung, BTMT-Entladung | `SSG_LIB_Commands.lsp` |
| ILS ▸ Foerderer | Durch TEF angetriebene Strecke; Kurven 90/60/30 links/rechts angetrieben Aussen + Innen (12) | `SSG_LIB_Commands.lsp` |
| ILS ▸ Gefaellestrecke | Kurven 90/60/30 links/rechts Gefaellestrecke (6) | `SSG_LIB_Commands.lsp` |
| Omniflo ▸ TEF Elemente | UmlenkR/L, AntriebL/R, TEF Gerade, KettenFoerderer (6) | `OmniModulInsert.lsp` |
| Omniflo ▸ Verbinder | alle `OMNI_TV_*` (18) | `OmniModulInsert.lsp` |
| Omniflo ▸ Boegen fuer Weichen | alle `OMNI_APBW_*` (14) | `OmniModulInsert.lsp` |
Aktiv (implementiert) sind u.a.: Kreisel, Eckrad, VarioFoerderer, EtageVarioFoerderer,
Gefaellestrecke, Omniflo Boegen (APB), Aluprofil-Geraden (AP), alle Weichen
(W90/W45/WP/WK/WKomb), Export (Sivas/CSV) und die Tests.
---
## Dateien ## Dateien
### `ssg_core.lsp` Kernbibliothek ### `ssg_core.lsp` Kernbibliothek
@@ -111,6 +133,20 @@ Interne Parser-Funktionen (nicht direkt aufrufen):
--- ---
### `ssg_lang.lsp` Sprachumschaltung (Deutsch/Englisch)
Zentrale Textverwaltung fuer benutzersichtbare Meldungen. Kern-Modul, wird direkt nach `ssg_core` geladen. Wird schrittweise auf weitere Module ausgerollt (siehe `doc/translate.md`).
| Funktion | Beschreibung |
| --- | --- |
| `ssg-text key` | Liefert Text zu `key` in `*ssg-lang*`, Fallback `de_DE`, dann Key selbst |
| `ssg-textf key werte` | Wie `ssg-text`, ersetzt Platzhalter `%1 %2 ...` durch `werte` (Liste) |
Sprache umschalten: Befehl `SSG_SPRACHE` (Menue → Konfiguration → Sprache) setzt `*ssg-lang*`
live und persistiert via `(setenv "DXFM_LANG" ...)`. Default ohne `DXFM_LANG` ist `"de_DE"`.
---
### `ssg_dbg.lsp` Debug-Logging ### `ssg_dbg.lsp` Debug-Logging
Dateibasiertes Debug-Log mit gepuffertem Schreiben. `dbgf`/`dbg`/`dbgmsg` puffern im Speicher, `dbgreturn` flusht auf die Platte (open/append/close). Dateibasiertes Debug-Log mit gepuffertem Schreiben. `dbgf`/`dbg`/`dbgmsg` puffern im Speicher, `dbgreturn` flusht auf die Platte (open/append/close).
@@ -197,9 +233,30 @@ Lädt alle Module in der richtigen Reihenfolge. Ermittelt den Pfad automatisch
### `VarioFoerderer.lsp` Vario-Förderer ### `VarioFoerderer.lsp` Vario-Förderer
Parametrischer Generator für ILS Vario-Förderanlagen. Liest Block-Geometrie aus einer DWG-Bibliothek (`DXFM_BLOCKS`). Alle Konstanten (Abstände, Winkel, Skalierung) werden via `ssg-cfg-or` aus `component_defaults.json` (Sektion `vario`) gelesen. Kompatibilitäts-Wrapper, der `vf_core.lsp` lädt (Plugin-Dispatcher-Architektur; lädt seinerseits `vf_standard.lsp`, `vf_etage.lsp`, `vf_linienzug.lsp`). Parametrischer Generator für ILS Vario-Förderanlagen. Liest Block-Geometrie aus einer DWG-Bibliothek (`DXFM_BLOCKS`). Alle Konstanten (Abstände, Winkel, Skalierung) werden via `ssg-cfg-or` aus `component_defaults.json` (Sektion `vario`) gelesen.
**Befehl:** `c:FOERDERANLAGE` **Befehl:** `c:FOERDERANLAGE` / `c:VarioFoerderer` wählt zuerst den Anlagen-Typ (Standard/Etage/Linienzug):
- **Typ „standard“ + Werteingabe:** läuft über den DCL-Dialog
[`dcl/variofoerderer.dcl`](../dcl/variofoerderer.dcl) (zwei Dialoge, `vfs-standard-dialog-ablauf`
in `vf_standard.lsp`): Dialog 1 (`vfs-dialog-eingabe-basis`) erfasst deltaL, deltaH,
Förderrichtung (Auf/Ab), Einfügehöhe, Fahrtrichtung und Seite; anschließend berechnet
`berechne-standard` die gültigen Winkel-Varianten, und Dialog 2
(`vfs-dialog-winkel-verteilung`) lässt Winkel und L_GF-Verteilung (vorne/hinten) wählen.
Startpunkt (X/Y) wird wie bei der Gefällestrecke vorher in der Zeichnung gepickt.
- **Typ „standard“ + 3D-Linie**, sowie **Typ „etage“** und **„linienzug“** bleiben
vollständig interaktiv (Kommandozeile), unverändert gegenüber dem bisherigen Ablauf.
**Bearbeiten (`c:VARIOFOERDERER_EDIT`):** Doppelklick auf einen `VF_n`-Block bzw.
Rechtsklick-Kontextmenü/`SSG_BLOCKEDIT` öffnet dieselben Dialoge, vorbelegt mit den
aktuellen Parametern, und baut die Strecke bei OK am selben Startpunkt neu auf (neue
`VF_n`-Nummer). Da `VF_n`-Blöcke auch von Etage- und Linienzug-Anlagen erzeugt werden
(deren komplexere Geometrie ein einfacher Neuaufbau zerstören würde), markiert
`vfs-xdata-schreiben` nur per Standard-Dialog erstellte Blöcke mit XDATA (App
`SSG_VF_EDIT`, Fahrtrichtung `hz`); Blöcke ohne diese Markierung weist
`c:VARIOFOERDERER_EDIT` mit einer Meldung ab, statt sie zu verändern. Winkel und L_GF1
werden aus den Sivas-Attributen (`VF_WINKEL`, `L_GF_m`) vorbelegt (Verteilung stets als
„Eigene Werte“ mit dem exakten aktuellen L_GF1).
**Wichtige interne Funktionen** (werden auch von `Gefaellestrecke.lsp` genutzt): **Wichtige interne Funktionen** (werden auch von `Gefaellestrecke.lsp` genutzt):
@@ -224,10 +281,36 @@ Setzt `VarioFoerderer.lsp` voraus (nutzt dessen `init-bibliothek`, `insert-block
**Befehl:** `c:GEFAELLESTRECKE` **Befehl:** `c:GEFAELLESTRECKE`
Zwei Modi: Drei Modi:
- **Modus 1:** Startpunkt + ΔL (Horizontalabstand) interaktiv abfragen - **Modus 1:** Startpunkt (X/Y) picken, restliche Parameter über den DCL-Dialog
- **Modus 2:** Bestehende 3D-Linie wählen (ΔL und Winkel werden daraus berechnet) [`dcl/gefaellestrecke.dcl`](../dcl/gefaellestrecke.dcl) eingeben (ΔL, Einfügehöhe Z,
Gefällewinkel, Fahrtrichtung, AUS-/EIN-Element je Winkel 30/90 und Seite links/rechts).
Die Einfügehöhe aus dem Dialog setzt die Z-Koordinate des Startpunkts.
- **Modus 2:** Bestehende 3D-Linie wählen (ΔL und Fahrtrichtung werden daraus berechnet),
restliche Parameter interaktiv über die Kommandozeile.
- **Modus 3:** Linienzug aus LINE-/ARC-Objekten; ARC-Segmente werden durch
Gefällebogen-Blöcke ersetzt, Winkel aus ΔH und Geometrie berechnet.
**Dialog-Hilfsfunktionen:** `gf-dialog-eingabe` (lädt/liest den DCL-Dialog, liefert
`(deltaL winkel hz-winkel as-seite es-seite einfuegehoehe as-winkel es-winkel)` oder `nil`
bei Abbruch) und `gf-modus12-abschluss` (gemeinsamer Abschluss für Modus 1+2: setzt die
Element-Masse per `vf-set-as-masse`/`vf-set-es-masse`, berechnet die Staustreckenlänge,
zeigt die Zusammenfassung und ruft `gefaellestrecke-einfuegen`).
Die AUS-/EIN-Element-Varianten (30/90 Grad, links/rechts) liegen als DWG-Blöcke
`AS_Element_<30|90>_<links|rechts>` bzw. `ES_Element_…` in `data/ils/2D|3D/`; ihre Maße
werden direkt aus dem Block gemessen (`vf-element-masse`), es gibt dafür keine JSON-Tabelle.
**Bearbeiten (`c:GEFAELLESTRECKE_EDIT`):** Doppelklick auf einen Gefällestrecken-Block
(`GF_n`) bzw. Rechtsklick-Kontextmenü/`SSG_BLOCKEDIT` öffnet denselben DCL-Dialog,
vorbelegt mit den aktuellen Parametern, und baut die Strecke bei OK am selben Startpunkt
neu auf. Damit Fahrtrichtung und Element-Winkel (30/90) verlustfrei rekonstruiert werden,
schreibt `gefaellestrecke-einfuegen` diese beim Erstellen als XDATA (App `SSG_GF_EDIT`,
Helfer `gf-xdata-schreiben`/`gf-xdata-lesen`) auf das `GF_n`-INSERT bewusst **nicht** in
den Sivas-Attributsatz, damit der Export unverändert bleibt. Ältere Blöcke ohne XDATA
werden aus den Attributen vorbelegt (Fahrtrichtung 0°, Element-Winkel 90° als Vorgabe).
Der Neuaufbau läuft über `gf-rebuild` (nicht-interaktiv, ohne Konsolen-Rückfrage).
--- ---
@@ -248,6 +331,21 @@ Der Omniflo-CSV-Export (Bogen/Weiche/Gerade, inkl. Merkmale-Aufbau und Sum-Zeile
seit Entfernung von `c:OMNI_EXPORT` ausschließlich über `c:EXPORTCSV``lib/export_csv.py` seit Entfernung von `c:OMNI_EXPORT` ausschließlich über `c:EXPORTCSV``lib/export_csv.py`
(`build_bogen_merkmale`, `build_weiche_merkmale`, `build_gerade_merkmale`, `build_omni_sum_merkmale`). (`build_bogen_merkmale`, `build_weiche_merkmale`, `build_gerade_merkmale`, `build_omni_sum_merkmale`).
**Ausgabeordner:** `c:EXPORTSIVAS`/`c:EXPORTCSV` schreiben immer nach `DXFM_RESULTS`.
`TEST_EXPORT_ALL` (siehe `tests/test_export_all.lsp`) leitet waehrend des Testlaufs stattdessen
nach `DXFM_TESTOUT` um, über die reine Lisp-Sitzungsvariable `*export-test-override*` (wird von
`csv:run-export` zusaetzlich zu `DXFM_RESULTS` abgefragt und danach garantiert wieder auf `nil`
zurueckgesetzt, auch bei einem Fehler, ueber `vl-catch-all-apply`).
**Wichtig:** Der Umweg über `*export-test-override*` ist bewusst gewaehlt und **kein**
`(setenv "DXFM_RESULTS" ...)`. In BricsCAD/AutoCAD schreibt `(setenv ...)` nicht nur in den
Windows-Prozess, sondern dauerhaft in die Profil-Registry der Anwendung der Wert überlebt
damit jeden Neustart und jedes `setenv.bat`, bis er erneut per `(setenv)` überschrieben wird.
Ein einziger `(setenv "DXFM_RESULTS" ...)`-Aufruf (z. B. ein frueherer, unvollstaendiger
Testlauf) würde `DXFM_RESULTS` für alle künftigen Sitzungen unwiderruflich auf den Testordner
umbiegen. Falls das bereits passiert ist, hilft nur ein manuelles
`(setenv "DXFM_RESULTS" "<richtiger Pfad>")` in BricsCAD, um den Profil-Wert zu korrigieren.
--- ---
### `tests.lsp` Testbefehle ### `tests.lsp` Testbefehle
@@ -289,9 +387,9 @@ AutoLISP-Implementierung fuer alle Omniflo-Komponenten: Boegen, Weichen, Verbind
| Boegen | `OMNI_APB_630_90`, `OMNI_APB_550_675`, `OMNI_APB_630_45`, `OMNI_APB_550_225`, `OMNI_APB_650_180` | Omniflo-Boegen ueber DCL-Dialog einfuegen | | Boegen | `OMNI_APB_630_90`, `OMNI_APB_550_675`, `OMNI_APB_630_45`, `OMNI_APB_550_225`, `OMNI_APB_650_180` | Omniflo-Boegen ueber DCL-Dialog einfuegen |
| Weichen | `OMNI_W90_*`, `OMNI_W45_*`, `OMNI_WP_*`, `OMNI_WK_*`, `OMNI_WKomb_*` | Omniflo-Weichen (Einfach/Doppel/Dreiwege, Delta, Stern) | | Weichen | `OMNI_W90_*`, `OMNI_W45_*`, `OMNI_WP_*`, `OMNI_WK_*`, `OMNI_WKomb_*` | Omniflo-Weichen (Einfach/Doppel/Dreiwege, Delta, Stern) |
| Geraden | `OMNI_AP60`, `OMNI_AP110`, `OMNI_APG110` | Omniflo-Geradenstuecke | | Geraden | `OMNI_AP60`, `OMNI_AP110`, `OMNI_APG110` | Omniflo-Geradenstuecke |
| TEF | `OMNI_TEF_UmlenkR/L`, `OMNI_TEF_AntriebL/R`, `OMNI_TEF_Gerade` | Omniflo-TEF-Elemente | | TEF ⚠️ | `OMNI_TEF_UmlenkR/L`, `OMNI_TEF_AntriebL/R`, `OMNI_TEF_Gerade`, `OMNI_KettenFoerderer` | **Dummy** (noch nicht implementiert, im Menue ausgegraut) |
| Transferwagen | `OMNI_TV_*` | Transferwagen-Komponenten und Schaltwerke | | Transferwagen ⚠️ | `OMNI_TV_*` | **Dummy** (noch nicht implementiert, im Menue ausgegraut) |
| Bogenweichen | `OMNI_APBW_*` | Omniflo-Bogenweichen (diverse Radien/Winkel) | | Bogenweichen ⚠️ | `OMNI_APBW_*` | **Dummy** (noch nicht implementiert, im Menue ausgegraut) |
| Bearbeiten | `OMNI_EDIT` | Omniflo-Block selektieren und Attribute bearbeiten | | Bearbeiten | `OMNI_EDIT` | Omniflo-Block selektieren und Attribute bearbeiten |
--- ---
@@ -299,6 +397,8 @@ AutoLISP-Implementierung fuer alle Omniflo-Komponenten: Boegen, Weichen, Verbind
### `SSG_LIB_Commands.lsp` Dummy-Befehle und SSG_BLOCKEDIT ### `SSG_LIB_Commands.lsp` Dummy-Befehle und SSG_BLOCKEDIT
Platzhalter-Definitionen fuer noch nicht implementierte Menueintraege. Gibt beim Aufruf eine Meldung aus. Platzhalter-Definitionen fuer noch nicht implementierte Menueintraege. Gibt beim Aufruf eine Meldung aus.
Alle zugehoerigen Menueintraege sind in `menu/SSG_LIB.mnu` mit `~` ausgegraut (siehe
Abschnitt ["Status: noch offene Menueintraege"](#status-noch-offene-menueintraege-im-menue-ausgegraut)).
Registrierte Dummy-Befehle: Registrierte Dummy-Befehle:
@@ -311,6 +411,13 @@ Registrierte Dummy-Befehle:
> `FOERDERANLAGE` ist nicht hier definiert dieser Befehl ist in `VarioFoerderer.lsp` implementiert. > `FOERDERANLAGE` ist nicht hier definiert dieser Befehl ist in `VarioFoerderer.lsp` implementiert.
**Konfigurationsbefehle** (Menue → Konfiguration):
| Befehl | Beschreibung |
| --- | --- |
| `SSG_DIM_SWITCH` | Schaltet zwischen 2D/3D-Bloecken um (setzt `DXFM_DIM`, `DXFM_BLOCKS`, `DXFM_OMNIFLO`) |
| `SSG_SPRACHE` | Oeffnet Dialog `sprache.dcl`, setzt `*ssg-lang*` und persistiert via `DXFM_LANG` (siehe [`ssg_lang.lsp`](#ssg_langlsp--sprachumschaltung-deutschenglisch)) |
**SSG_BLOCKEDIT** Doppelklick/Kontextmenue-Dispatcher: **SSG_BLOCKEDIT** Doppelklick/Kontextmenue-Dispatcher:
Erkennt den Blocktyp des selektierten INSERT-Blocks und ruft den passenden Bearbeitungsbefehl auf: Erkennt den Blocktyp des selektierten INSERT-Blocks und ruft den passenden Bearbeitungsbefehl auf:
+105 -10
View File
@@ -15,6 +15,55 @@
(princ) (princ)
) )
;; --- ILS / Zusatzmodul: Sensoren (Scanner / Separator) einfuegen ---
;; Ermittelt den Pfad zu einer Sensor-Blockdatei. Die Sensor-Bloecke
;; werden fest aus data/ils/3D geladen (unabhaengig von der
;; 2D/3D-Umschaltung).
(defun ils-sensor-pfad (fname / p)
(setq p (strcat (getenv "DXFMAKRO") "\\data\\ils\\3D\\" fname ".dwg"))
(if (findfile p) p nil)
)
;; Fuegt einen Sensor-Block wiederholt ein, bis der Benutzer mit
;; ENTER oder ESC abbricht. Rotation je Einfuegung interaktiv.
(defun ils-insert-sensor (fname / pfad pt oldattreq n res)
(setq pfad (ils-sensor-pfad fname))
(if (null pfad)
(princ (strcat "\n>>> FEHLER: Blockdatei '" fname ".dwg' nicht gefunden."
" (in data/ils/3D pruefen)"))
(progn
(setq oldattreq (getvar "ATTREQ"))
(setvar "ATTREQ" 0)
(setq n 0)
;; Punkt abfragen; ENTER liefert nil, ESC einen abgefangenen Fehler -
;; beides beendet die Schleife sauber (ATTREQ wird wiederhergestellt).
(while
(progn
(setq res (vl-catch-all-apply
'getpoint
(list (strcat "\nEinfuegepunkt fuer " fname " [ENTER=Ende]: "))))
(and (not (vl-catch-all-error-p res)) res)
)
(setq pt res)
(command "_.INSERT" pfad pt "" "" pause)
(setq n (1+ n))
)
(setvar "ATTREQ" oldattreq)
(princ (strcat "\n>>> " (itoa n) " x " fname " eingefuegt."))
)
)
(princ)
)
(defun c:ILS_SCANNER_INSERT ()
(ils-insert-sensor "Scanner")
)
(defun c:ILS_SEPARATOR_INSERT ()
(ils-insert-sensor "Separator_SP")
)
;; --- ILS / Foerderer --- ;; --- ILS / Foerderer ---
(defun c:ILS_TEF_Strecke () (defun c:ILS_TEF_Strecke ()
(princ "\n[DUMMY] ILS_TEF_Strecke aufgerufen") (princ "\n[DUMMY] ILS_TEF_Strecke aufgerufen")
@@ -132,9 +181,41 @@
(setenv "DXFM_DIM" dim-neu) (setenv "DXFM_DIM" dim-neu)
(setenv "DXFM_BLOCKS" (strcat basis "\\data\\ils\\" dim-neu)) (setenv "DXFM_BLOCKS" (strcat basis "\\data\\ils\\" dim-neu))
(setenv "DXFM_OMNIFLO" (strcat basis "\\data\\omniflo\\" dim-neu)) (setenv "DXFM_OMNIFLO" (strcat basis "\\data\\omniflo\\" dim-neu))
(princ (strcat "\nModus umgeschaltet auf: " dim-neu)) (princ (ssg-textf "dim-switch-modus" (list dim-neu)))
(princ (strcat "\n DXFM_BLOCKS = " (getenv "DXFM_BLOCKS"))) (princ (ssg-textf "dim-switch-blocks" (list (getenv "DXFM_BLOCKS"))))
(princ (strcat "\n DXFM_OMNIFLO = " (getenv "DXFM_OMNIFLO"))) (princ (ssg-textf "dim-switch-omniflo" (list (getenv "DXFM_OMNIFLO"))))
(princ)
)
;; ============================================================
;; SSG_SPRACHE - Sprache umschalten (Deutsch/Englisch)
;; Setzt *ssg-lang* live und persistiert ueber DXFM_LANG
;; ============================================================
(defun ssg-sprache-init ( / idx)
(start_list "sprache")
(add_list "Deutsch")
(add_list "Englisch")
(end_list)
(setq idx (if (= *ssg-lang* "en_GB") "1" "0"))
(set_tile "sprache" idx)
)
(defun ssg-sprache-accept ( / idx neu)
(setq idx (get_tile "sprache"))
(setq neu (if (= idx "1") "en_GB" "de_DE"))
(setq *ssg-lang* neu)
(setenv "DXFM_LANG" neu)
)
(defun c:SSG_SPRACHE ()
(ssg-dialog-run
(strcat (getenv "DXFM_DCL") "/sprache.dcl")
"sprache"
'ssg-sprache-init
'ssg-sprache-accept
)
(princ (ssg-textf "sprache-gewechselt" (list *ssg-lang*)))
(princ) (princ)
) )
@@ -149,13 +230,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)
) )
@@ -166,7 +247,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)
) )
@@ -177,16 +258,30 @@
(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)
) )
;; Gefaellestrecke-Bloecke (GF_n) -> GEFAELLESTRECKE_EDIT (DCL-Dialog)
((wcmatch bname "GF_*")
(princ (ssg-textf "cmd-gefaelle-bearbeiten" (list bname)))
(c:GEFAELLESTRECKE_EDIT)
)
;; VarioFoerderer-Bloecke (VF_n) -> VARIOFOERDERER_EDIT (DCL-Dialog);
;; weist Bloecke ohne SSG_VF_EDIT-XDATA (Etage/Linienzug/Altbestand)
;; intern selbst ab, siehe c:VARIOFOERDERER_EDIT in vf_standard.lsp.
((wcmatch bname "VF_*")
(princ (ssg-textf "cmd-variofoerderer-bearbeiten" (list bname)))
(c:VARIOFOERDERER_EDIT)
)
;; Omniflo-Bloecke -> OMNI_EDIT ;; Omniflo-Bloecke -> OMNI_EDIT
;; Erkennung: TEILEART-Attribut vorhanden, AP110-Blockname oder rein numerisch ;; Erkennung: TEILEART-Attribut vorhanden, AP110-Blockname oder rein numerisch
((progn ((progn
@@ -198,13 +293,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")
) )
) )
+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"))
) )
+272
View File
@@ -0,0 +1,272 @@
;; ============================================================
;; addattribute.lisp
;; Synchronisiert ATTDEF-Attribute in den ILS-Block-DWGs mit den
;; Werten aus allocations.json.
;;
;; Es wird zwischen data/ils/2D und data/ils/3D unterschieden: nach
;; Auswahl des Verzeichnisses wird die dortige allocations.json
;; gelesen (data/ils/<2D|3D>/allocations.json) und anschliessend
;; werden ausschliesslich die DWGs in genau diesem Verzeichnis
;; bearbeitet.
;;
;; Ablauf je JSON-Eintrag "Blockname": {"TAG": "Wert", ...}:
;; - <Blockname>.dwg im selben Verzeichnis wie die JSON oeffnen
;; - je Attribut (TAG/Wert):
;; - ATTDEF mit diesem Tag existiert nicht -> neu anlegen,
;; Vorgabewert = JSON-Wert (auch wenn dieser leer ist)
;; - ATTDEF existiert, ist aber leer -> mit JSON-Wert befuellen
;; - ATTDEF existiert und ist bereits befuellt
;; -> NUR ueberschreiben,
;; wenn der JSON-Wert NICHT leer ("") ist. Ein leerer JSON-Wert
;; loescht also nie einen bereits vorhandenen Wert.
;; - DWG nur dann speichern, wenn sich mindestens ein Attributwert
;; geaendert hat oder neu angelegt wurde (bessere Nachverfolgbarkeit
;; im Versionsvergleich). Falls durch dieses Skript geoeffnet, wird
;; die DWG anschliessend wieder geschlossen. War die DWG schon vorher
;; offen, bleibt sie offen.
;;
;; Voraussetzung: DXFM_DATA ist gesetzt (siehe bin/setenv.bat).
;;
;; Aufruf in BricsCAD:
;; (load "C:/.../data/ils/2D/addattribute.lisp")
;; ILS_ATTR_SYNC
;; ============================================================
(vl-load-com)
;; ssg_core.lsp (JSON-Parser ssg-cfg-parse-nested) sicherstellen,
;; falls das Menue/die Kern-Module noch nicht geladen wurden.
(if (not (car (atoms-family 1 '("SSG-CFG-PARSE-NESTED"))))
(if (getenv "DXFM_LISP")
(load (strcat (vl-string-translate "\\" "/" (getenv "DXFM_LISP")) "/ssg_core.lsp"))
)
)
;; ------------------------------------------------------------
;; Bereits offenes Dokument mit gegebenem Pfad suchen (oder nil)
;; ------------------------------------------------------------
(defun iad-find-open-doc (dwg-pfad / docs anzahl i doc full treffer)
(setq docs (vla-get-Documents (vlax-get-acad-object))
anzahl (vla-get-Count docs)
i 0
treffer nil
dwg-pfad (strcase (vl-string-translate "\\" "/" dwg-pfad))
)
(while (and (< i anzahl) (not treffer))
(setq doc (vla-item docs i))
(setq full (strcase (vl-string-translate "\\" "/" (vla-get-FullName doc))))
(if (= full dwg-pfad) (setq treffer doc))
(setq i (1+ i))
)
treffer
)
;; ------------------------------------------------------------
;; Ein einzelnes ATTDEF aktualisieren (Ueberschreib-Regel)
;; Rueckgabe: t, wenn der Wert tatsaechlich geaendert wurde
;; ------------------------------------------------------------
(defun iad-update-attdef (ent jsonwert / ed altwert)
(setq ed (entget ent)
altwert (cdr (assoc 1 ed))
)
(if (null altwert) (setq altwert ""))
(cond
((equal altwert jsonwert)
(princ (strcat "\n = " (cdr (assoc 2 ed)) " = '" altwert "' (unveraendert)"))
nil
)
((or (= (strlen altwert) 0) (> (strlen jsonwert) 0))
(entmod (subst (cons 1 jsonwert) (assoc 1 ed) ed))
(princ (strcat "\n - " (cdr (assoc 2 ed)) " = '" jsonwert "'"))
t
)
(t
(princ (strcat "\n = " (cdr (assoc 2 ed)) " = '" altwert "' (unveraendert, JSON-Wert leer)"))
nil
)
)
)
;; ------------------------------------------------------------
;; Neues (unsichtbares) ATTDEF anlegen
;; ------------------------------------------------------------
(defun iad-create-attdef (tag wert ypos texthoehe layer)
(entmake (list
'(0 . "ATTDEF")
(cons 8 layer)
(cons 10 (list 0.0 ypos 0.0))
(cons 40 texthoehe)
(cons 1 wert)
(cons 3 tag)
(cons 2 tag)
'(70 . 1)
))
(princ (strcat "\n + " tag " = '" wert "' (neu angelegt)"))
)
;; ------------------------------------------------------------
;; Alle Attribute eines JSON-Eintrags im aktiven Dokument abgleichen
;; attribs = (("TAG" . "Wert") ...)
;; Rueckgabe: t, wenn mindestens ein Attribut geaendert/neu angelegt wurde
;; ------------------------------------------------------------
(defun iad-sync-attribs-in-current-doc (attribs / texthoehe layer ss anzahl i ent ed
tag wert pt vorhandene ypos gefunden paar geaendert)
(setq texthoehe (ssg-cfg-or "ils_attribut" "texthoehe" 50.0)
layer (ssg-cfg-or "ils_attribut" "layer" "0")
vorhandene nil
ypos 0.0
geaendert nil
)
;; Vorhandene ATTDEFs einsammeln (Tag -> Entity) und tiefsten Y-Wert merken
(setq ss (ssget "X" '((0 . "ATTDEF"))))
(if ss
(progn
(setq i 0 anzahl (sslength ss))
(while (< i anzahl)
(setq ent (ssname ss i)
ed (entget ent)
tag (cdr (assoc 2 ed))
pt (cdr (assoc 10 ed))
)
(setq vorhandene (cons (cons tag ent) vorhandene))
(if (and pt (< (cadr pt) ypos)) (setq ypos (cadr pt)))
(setq i (1+ i))
)
)
)
(setq ypos (- ypos (* texthoehe 2.0)))
(foreach paar attribs
(setq tag (car paar)
wert (cdr paar)
)
(if (null wert) (setq wert ""))
(setq gefunden (cdr (assoc tag vorhandene)))
(if gefunden
(if (iad-update-attdef gefunden wert) (setq geaendert t))
(progn
(iad-create-attdef tag wert ypos texthoehe layer)
(setq ypos (- ypos (* texthoehe 2.0)))
(setq geaendert t)
)
)
)
geaendert
)
;; ------------------------------------------------------------
;; Hauptbefehl
;; ------------------------------------------------------------
(defun c:ILS_ATTR_SYNC ( / data-dir json-pfad dwg-dir dwg-unterverz daten orig-doc anzahl-aktualisiert
anzahl-unveraendert anzahl-fehler anzahl-fehlt eintrag blockname attribs
dwg-pfad bereits-offen fehler fehlende-liste name)
(setq data-dir (getenv "DXFM_DATA"))
(if (not data-dir)
(progn
(alert "DXFM_DATA ist nicht gesetzt.\nBitte zuerst bin/setenv.bat ausfuehren.")
(exit)
)
)
(setq data-dir (vl-string-translate "\\" "/" data-dir))
(initget "2D 3D")
(setq dwg-unterverz (getkword "\nDWG-Verzeichnis waehlen [2D/3D] <2D>: "))
(if (not dwg-unterverz) (setq dwg-unterverz "2D"))
(setq dwg-dir (strcat data-dir "/ils/" dwg-unterverz)
json-pfad (strcat dwg-dir "/allocations.json")
)
(if (not (findfile json-pfad))
(progn
(alert (strcat "JSON nicht gefunden:\n" json-pfad))
(exit)
)
)
(setq daten (ssg-cfg-parse-nested (ssg-read-file-lines json-pfad)))
(if (not daten)
(progn
(alert "JSON konnte nicht gelesen werden oder ist leer.")
(exit)
)
)
(setq orig-doc (vla-get-ActiveDocument (vlax-get-acad-object))
anzahl-aktualisiert 0
anzahl-unveraendert 0
anzahl-fehler 0
anzahl-fehlt 0
fehlende-liste nil
)
(foreach eintrag daten
(setq blockname (car eintrag)
attribs (cdr eintrag)
dwg-pfad (strcat dwg-dir "/" blockname ".dwg")
)
(if (findfile dwg-pfad)
(progn
(princ (strcat "\n[ATTR-SYNC] Bearbeite " blockname ".dwg ..."))
(setq bereits-offen (iad-find-open-doc dwg-pfad))
(setq fehler
(vl-catch-all-apply
(function
(lambda ( / geaendert)
(if bereits-offen
(progn
(vlax-put-property (vlax-get-acad-object) 'ActiveDocument bereits-offen)
(setq geaendert (iad-sync-attribs-in-current-doc attribs))
)
(progn
(command "_.OPEN" dwg-pfad)
(setq geaendert (iad-sync-attribs-in-current-doc attribs))
)
)
(if geaendert
(command "_.QSAVE")
(princ "\n (keine Aenderungen, DWG nicht gespeichert)")
)
(if (not bereits-offen) (command "_.CLOSE"))
geaendert
)
)
nil
)
)
(if (vl-catch-all-error-p fehler)
(progn
(princ (strcat "\n[ATTR-SYNC] FEHLER bei " blockname ".dwg: "
(vl-catch-all-error-message fehler)))
(setq anzahl-fehler (1+ anzahl-fehler))
)
(if fehler
(setq anzahl-aktualisiert (1+ anzahl-aktualisiert))
(setq anzahl-unveraendert (1+ anzahl-unveraendert))
)
)
)
(progn
(setq anzahl-fehlt (1+ anzahl-fehlt))
(setq fehlende-liste (cons (strcat blockname ".dwg") fehlende-liste))
)
)
)
(vlax-put-property (vlax-get-acad-object) 'ActiveDocument orig-doc)
(princ (strcat "\n[ATTR-SYNC] Fertig: " (itoa anzahl-aktualisiert) " DWG(s) aktualisiert, "
(itoa anzahl-unveraendert) " ueberprueft (keine Aenderungen), "
(itoa anzahl-fehler) " Fehler, "
(itoa anzahl-fehlt) " nicht gefunden."))
(if fehlende-liste
(progn
(princ "\n[ATTR-SYNC] WARNUNG: DWG nicht gefunden fuer:")
(foreach name (reverse fehlende-liste)
(princ (strcat "\n - " name))
)
)
)
(princ)
)
(princ "\naddattribute.lisp geladen. Befehl: ILS_ATTR_SYNC")
(princ)
+243
View File
@@ -0,0 +1,243 @@
;; ============================================================
;; collect_attributes.lsp
;; Sammelt die aktuellen ATTDEF-Werte aller Bloecke (DWG-Dateien)
;; eines Verzeichnisses und schreibt sie als JSON-Datei
;; "allocations_collected.json" - im selben Format wie
;; allocations.json (siehe addattribute.lsp):
;; {"Blockname": {"TAG1": "Wert1", "TAG2": "Wert2", ...}, ...}
;;
;; Wird zunaechst fuer data/ils/2D und data/ils/3D ausgefuehrt -
;; je Verzeichnis entsteht eine eigene allocations_collected.json,
;; direkt im jeweiligen Verzeichnis abgelegt.
;;
;; Voraussetzung: DXFM_DATA ist gesetzt (siehe bin/setenv.bat).
;;
;; Aufruf in BricsCAD:
;; (load "C:/.../Lisp/collect_attributes.lsp")
;; ILS_ATTR_COLLECT
;; ============================================================
(vl-load-com)
;; ------------------------------------------------------------
;; Bereits offenes Dokument mit gegebenem Pfad suchen (oder nil)
;; ------------------------------------------------------------
(defun cac-find-open-doc (dwg-pfad / docs anzahl i doc full treffer)
(setq docs (vla-get-Documents (vlax-get-acad-object))
anzahl (vla-get-Count docs)
i 0
treffer nil
dwg-pfad (strcase (vl-string-translate "\\" "/" dwg-pfad))
)
(while (and (< i anzahl) (not treffer))
(setq doc (vla-item docs i))
(setq full (strcase (vl-string-translate "\\" "/" (vla-get-FullName doc))))
(if (= full dwg-pfad) (setq treffer doc))
(setq i (1+ i))
)
treffer
)
;; ------------------------------------------------------------
;; String fuer JSON escapen (Anfuehrungszeichen/Backslash)
;; ------------------------------------------------------------
(defun cac-json-escape (s)
(if (null s) (setq s ""))
(setq s (vl-string-subst "\\\\" "\\" s))
(vl-string-subst "\\\"" "\"" s)
)
;; ------------------------------------------------------------
;; Alle ATTDEFs im aktiven Dokument einsammeln (alphabetisch nach
;; Tag sortiert, fuer reproduzierbare Ausgabe) -> (("TAG" . "Wert") ...)
;; ------------------------------------------------------------
(defun cac-collect-attdefs-in-current-doc ( / ss anzahl i ent ed tag wert ergebnis)
(setq ss (ssget "X" '((0 . "ATTDEF"))))
(setq ergebnis nil)
(if ss
(progn
(setq i 0 anzahl (sslength ss))
(while (< i anzahl)
(setq ent (ssname ss i)
ed (entget ent)
tag (cdr (assoc 2 ed))
wert (cdr (assoc 1 ed))
)
(if (null wert) (setq wert ""))
(setq ergebnis (cons (cons tag wert) ergebnis))
(setq i (1+ i))
)
)
)
(vl-sort ergebnis (function (lambda (a b) (< (strcase (car a)) (strcase (car b))))))
)
;; ------------------------------------------------------------
;; Attribut-Alist ((TAG . Wert) ...) als eingerueckten JSON-Objekt-
;; Text formatieren, z.B.:
;; {
;; "TAG1": "Wert1",
;; "TAG2": "Wert2"
;; }
;; einruecken = Einrueckung der schliessenden Klammer
;; ------------------------------------------------------------
(defun cac-attribs-to-json (attribs einruecken / innen zeilen)
(if (null attribs)
"{}"
(progn
(setq innen (strcat einruecken " "))
(setq zeilen
(mapcar
(function (lambda (paar)
(strcat innen "\"" (cac-json-escape (car paar)) "\": \""
(cac-json-escape (cdr paar)) "\"")
))
attribs
)
)
(strcat "{\n"
(car zeilen)
(apply 'strcat (mapcar (function (lambda (z) (strcat ",\n" z))) (cdr zeilen)))
"\n" einruecken "}"
)
)
)
)
;; ------------------------------------------------------------
;; Eine DWG-Datei oeffnen (falls noetig), ATTDEFs einsammeln und
;; die Datei wieder schliessen (falls durch diese Funktion geoeffnet).
;; Rueckgabe: ('ok . (("TAG" . "Wert") ...)) oder ('fehler . meldung)
;; ------------------------------------------------------------
(defun cac-collect-dwg (dwg-pfad / bereits-offen ergebnis fehler)
(setq bereits-offen (cac-find-open-doc dwg-pfad))
(setq ergebnis nil)
(setq fehler
(vl-catch-all-apply
(function
(lambda ()
(if bereits-offen
(vlax-put-property (vlax-get-acad-object) 'ActiveDocument bereits-offen)
(command "_.OPEN" dwg-pfad)
)
(setq ergebnis (cac-collect-attdefs-in-current-doc))
(if (not bereits-offen) (command "_.CLOSE"))
)
)
nil
)
)
(if (vl-catch-all-error-p fehler)
(cons 'fehler (vl-catch-all-error-message fehler))
(cons 'ok ergebnis)
)
)
;; ------------------------------------------------------------
;; Alle *.dwg eines Verzeichnisses einlesen und als
;; allocations_collected.json (json-pfad) schreiben.
;; ------------------------------------------------------------
(defun cac-collect-directory (dwg-dir json-pfad / dateien datei dwg-pfad orig-doc
blockname ergebnis anzahl-ok anzahl-fehler
fehler-liste eintraege fh erste paar)
(setq dwg-dir (vl-string-right-trim "/" (vl-string-translate "\\" "/" dwg-dir)))
(if (not (findfile dwg-dir))
(princ (strcat "\n[ATTR-COLLECT] Verzeichnis nicht gefunden, uebersprungen: " dwg-dir))
(progn
(setq dateien (vl-directory-files dwg-dir "*.dwg" 1))
(if (not dateien)
(princ (strcat "\n[ATTR-COLLECT] Keine DWG-Dateien in: " dwg-dir))
(progn
(setq orig-doc (vla-get-ActiveDocument (vlax-get-acad-object))
anzahl-ok 0
anzahl-fehler 0
fehler-liste nil
eintraege nil
)
(foreach datei dateien
(setq blockname (vl-filename-base datei)
dwg-pfad (strcat dwg-dir "/" datei)
)
(princ (strcat "\n[ATTR-COLLECT] Lese " datei " ..."))
(setq ergebnis (cac-collect-dwg dwg-pfad))
(if (equal (car ergebnis) 'fehler)
(progn
(princ (strcat "\n[ATTR-COLLECT] FEHLER bei " datei ": " (cdr ergebnis)))
(setq anzahl-fehler (1+ anzahl-fehler))
(setq fehler-liste (cons datei fehler-liste))
)
(progn
(setq eintraege (cons (cons blockname (cdr ergebnis)) eintraege))
(setq anzahl-ok (1+ anzahl-ok))
)
)
)
(vlax-put-property (vlax-get-acad-object) 'ActiveDocument orig-doc)
(setq eintraege (reverse eintraege))
;; JSON schreiben
(setq fh (open json-pfad "w"))
(if (null fh)
(princ (strcat "\n[ATTR-COLLECT] FEHLER: Datei kann nicht geschrieben werden: " json-pfad))
(progn
(write-line "{" fh)
(setq erste T)
(foreach paar eintraege
(if (not erste) (write-line "," fh))
(write-line (strcat " \"" (cac-json-escape (car paar)) "\": "
(cac-attribs-to-json (cdr paar) " "))
fh)
(setq erste nil)
)
(write-line "}" fh)
(close fh)
(princ (strcat "\n[ATTR-COLLECT] " json-pfad " geschrieben ("
(itoa anzahl-ok) " Bloecke)."))
)
)
(princ (strcat "\n[ATTR-COLLECT] " dwg-dir " fertig: "
(itoa anzahl-ok) " gelesen, "
(itoa anzahl-fehler) " Fehler."))
(if fehler-liste
(progn
(princ "\n[ATTR-COLLECT] WARNUNG: Fehler bei:")
(foreach datei (reverse fehler-liste)
(princ (strcat "\n - " datei))
)
)
)
)
)
)
)
(princ)
)
;; ------------------------------------------------------------
;; Hauptbefehl - verarbeitet DXFM_DATA/ils/2D und DXFM_DATA/ils/3D
;; ------------------------------------------------------------
(defun c:ILS_ATTR_COLLECT ( / data-dir basis-dir subverz dwg-dir json-pfad)
(setq data-dir (getenv "DXFM_DATA"))
(if (not data-dir)
(progn
(alert "DXFM_DATA ist nicht gesetzt.\nBitte zuerst bin/setenv.bat ausfuehren.")
(exit)
)
)
(setq data-dir (vl-string-translate "\\" "/" data-dir)
basis-dir (strcat data-dir "/ils")
)
(foreach subverz '("2D" "3D")
(setq dwg-dir (strcat basis-dir "/" subverz)
json-pfad (strcat dwg-dir "/allocations_collected.json")
)
(princ (strcat "\n[ATTR-COLLECT] === " subverz " ==="))
(cac-collect-directory dwg-dir json-pfad)
)
(princ)
)
(princ "\ncollect_attributes.lsp geladen. Befehl: ILS_ATTR_COLLECT")
(princ)
+365
View File
@@ -0,0 +1,365 @@
;;; ============================================================
;;; count_sep_scan.lsp - Eigenstaendiges Zaehl-Werkzeug
;;; ------------------------------------------------------------
;;; Zaehlt die manuell platzierten Bloecke "Scanner" und
;;; "Separator_SP" je ILS-Block (Kreisel / VarioFoerderer /
;;; Gefaellestrecke) und schreibt die Anzahlen in die Attribute
;;; des jeweiligen ILS-Blocks. Anschliessend QSAVE.
;;;
;;; Zuordnung eines Sensors zu einem ILS-Block (Z wird ignoriert):
;;; - Scanner: der Einfuegepunkt (X/Y) muss in der Bounding-Box
;;; des ILS-Blocks liegen. Die 3D-Geometrie des Scanners kann
;;; weit vom Einfuegepunkt entfernt sein, daher zaehlt hier der
;;; Einfuegepunkt (dort klickt der Benutzer auf den Block).
;;; - Separator: der geometrische Mittelpunkt (Zentrum der eigenen
;;; Bounding-Box, unabhaengig vom $INSBASE) muss in der
;;; Bounding-Box des ILS-Blocks liegen.
;;; - Liegt der Punkt in mehreren Boxen (Ueberlappung), wird
;;; der ILS-Block mit dem naechstgelegenen Box-Zentrum gewaehlt.
;;; - Ein optionaler Toleranzrand (*senstol*) vergroessert die
;;; Box, damit Sensoren knapp am Rand noch erfasst werden.
;;;
;;; Aufruf: ZAEHLE_SEP_SCAN
;;; Laden: per APPLOAD oder (load "count_sep_scan")
;;; ============================================================
(vl-load-com)
;;; ------------------------------------------------------------
;;; KONFIGURATION (bei Bedarf anpassen)
;;; ------------------------------------------------------------
;; Toleranzrand um die ILS-Block-Box in Zeichnungseinheiten (mm).
;; 0.0 = exakte Box. Groesserer Wert = Sensoren knapp ausserhalb
;; werden noch dem ILS-Block zugerechnet.
(if (null *senstol*) (setq *senstol* 0.0))
;; Blockname-Muster (wcmatch, Grossschreibung) fuer die manuell
;; platzierten Sensoren.
(setq *scanner-pattern* "SCANNER,SCANNER_*")
(setq *separator-pattern* "SEPARATOR_SP,SEPARATOR_SP_*")
;; Blockname-Muster fuer die INTERN im ILS-Block (in der Kette)
;; gezeichneten Separatoren. Diese bilden die Basis fuer
;; ANZAHL_SEPARATOR und werden bei jedem Lauf frisch gezaehlt.
(setq *intern-separator-pattern* "STAUSTRECKE_SEPARATOR_SP*")
;;; ------------------------------------------------------------
;;; ILS-Block-Erkennung und zugehoerige Attribut-Tags
;;; Alle ILS-Bloecke (Kreisel / VF / GF) verwenden einheitlich
;;; ANZAHL_SCANNER und ANZAHL_SEPARATOR.
;;; Rueckgabe: (scanner-tag separator-tag) oder nil
;;; ------------------------------------------------------------
(defun cs-carrier-tags (nm / up)
(setq up (strcase nm))
(if (or (wcmatch up "KREISEL_*")
(wcmatch up "VF_*")
(wcmatch up "GF_*"))
(list "ANZAHL_SCANNER" "ANZAHL_SEPARATOR")
nil
)
)
;;; ------------------------------------------------------------
;;; Sensor-Erkennung
;;; Rueckgabe: 'scanner | 'separator | nil
;;; ------------------------------------------------------------
(defun cs-sensor-kind (nm / up)
(setq up (strcase nm))
(cond
((wcmatch up *scanner-pattern*) 'scanner)
((wcmatch up *separator-pattern*) 'separator)
(t nil)
)
)
;;; ------------------------------------------------------------
;;; Punkt-Rueckgabe von vla-getboundingbox in eine Liste wandeln.
;;; BricsCAD liefert ein Safearray, AutoCAD ein Variant mit
;;; Safearray - beide Faelle werden hier abgedeckt.
;;; ------------------------------------------------------------
(defun cs-pt->list (v)
(cond
((= (type v) 'variant) (vlax-safearray->list (vlax-variant-value v)))
((= (type v) 'safearray) (vlax-safearray->list v))
((listp v) v)
(t nil)
)
)
;;; ------------------------------------------------------------
;;; Bounding-Box eines INSERT holen (WCS, achsparallel).
;;; Erzwingt vorher ein vla-update (Regen des Objekts), da
;;; vla-getboundingbox sonst auf nicht-regenerierten oder auf
;;; eingefrorenen Layern liegenden Bloecken scheitert.
;;; Rueckgabe: (minx miny maxx maxy) oder nil bei Fehler.
;;; *cs-last-error* enthaelt bei Fehler den echten COM-Fehlertext.
;;; ------------------------------------------------------------
(defun cs-bbox (ent / obj res)
(setq *cs-last-error* nil)
(setq obj (vlax-ename->vla-object ent))
;; Objekt regenerieren (Fehler ignorieren)
(vl-catch-all-apply 'vla-update (list obj))
(setq res
(vl-catch-all-apply
'(lambda ( / ll ur)
(vla-getboundingbox obj 'll 'ur)
(list (cs-pt->list ll) (cs-pt->list ur)))))
(if (vl-catch-all-error-p res)
(progn
(setq *cs-last-error* (vl-catch-all-error-message res))
nil)
(list (car (car res)) (cadr (car res)) ;; minx miny
(car (cadr res)) (cadr (cadr res))) ;; maxx maxy
)
)
;;; ------------------------------------------------------------
;;; Referenzpunkt eines Sensors (X/Y), je nach Typ:
;;; - Scanner : Einfuegepunkt (DXF-Gruppe 10).
;;; - Separator : geometrischer Mittelpunkt seiner eigenen
;;; Bounding-Box (unabhaengig vom $INSBASE),
;;; Fallback auf den Einfuegepunkt.
;;; ------------------------------------------------------------
(defun cs-sensor-point (ent ed kind / bb)
(if (eq kind 'scanner)
(cdr (assoc 10 ed))
(progn
(setq bb (cs-bbox ent))
(if bb
(list (/ (+ (nth 0 bb) (nth 2 bb)) 2.0)
(/ (+ (nth 1 bb) (nth 3 bb)) 2.0))
(cdr (assoc 10 ed))
)
)
)
)
;;; ------------------------------------------------------------
;;; Liegt Punkt pt (X/Y) in ILS-Block-Record rec (mit Toleranz)?
;;; rec = (ename tagScan tagSep minx miny maxx maxy cx cy)
;;; ------------------------------------------------------------
(defun cs-in-box (pt rec / x y)
(setq x (car pt) y (cadr pt))
(and (>= x (- (nth 3 rec) *senstol*))
(<= x (+ (nth 5 rec) *senstol*))
(>= y (- (nth 4 rec) *senstol*))
(<= y (+ (nth 6 rec) *senstol*)))
)
;;; ------------------------------------------------------------
;;; Sensor-Punkt einem ILS-Block zuordnen.
;;; Rueckgabe: ILS-Block-Record oder nil (keine Zuordnung).
;;; Bei mehreren Treffern: naechstes Box-Zentrum (X/Y).
;;; ------------------------------------------------------------
(defun cs-assign (pt carriers / matches best bestd d)
(setq matches nil)
(foreach rec carriers
(if (cs-in-box pt rec) (setq matches (cons rec matches))))
(cond
((null matches) nil)
((= (length matches) 1) (car matches))
(t
(setq best nil bestd nil)
(foreach rec matches
(setq d (distance (list (car pt) (cadr pt))
(list (nth 7 rec) (nth 8 rec))))
(if (or (null bestd) (< d bestd))
(setq bestd d best rec)))
best)
)
)
;;; ------------------------------------------------------------
;;; Zaehler in einer Assoc-Liste (Schluessel = ename) erhoehen.
;;; ------------------------------------------------------------
(defun cs-bump (alist key / pair)
(setq pair (assoc key alist))
(if pair
(subst (cons key (1+ (cdr pair))) pair alist)
(cons (cons key 1) alist))
)
;;; ------------------------------------------------------------
;;; Attributwert an einem INSERT setzen (Tag ohne Gross/Klein).
;;; Rueckgabe: T wenn Tag gefunden und gesetzt, sonst nil.
;;; ------------------------------------------------------------
(defun cs-set-att (ins tag val / e ed done ok)
(setq e (entnext ins) done nil ok nil)
(while (and e (not done))
(setq ed (entget e))
(cond
((= (cdr (assoc 0 ed)) "ATTRIB")
(if (= (strcase (cdr (assoc 2 ed))) (strcase tag))
(progn
(entmod (subst (cons 1 val) (assoc 1 ed) ed))
(entupd e)
(setq ok t))))
((= (cdr (assoc 0 ed)) "SEQEND") (setq done t))
)
(setq e (entnext e))
)
ok
)
;;; ------------------------------------------------------------
;;; Zaehlt rekursiv, wie oft ein Block (Muster pat) in der
;;; Definition des Blocks bname verwendet wird - inklusive
;;; verschachtelter Unterbloecke. Damit wird die interne Anzahl
;;; der Kette-Separatoren aus der Geometrie ermittelt.
;;; ------------------------------------------------------------
(defun cs-count-nested (bname pat / e ed nm n stop)
(setq n 0 stop nil)
(setq e (tblobjname "BLOCK" bname))
(if e
(progn
(setq e (entnext e))
(while (and e (not stop))
(setq ed (entget e))
(cond
((= (cdr (assoc 0 ed)) "ENDBLK") (setq stop t))
((= (cdr (assoc 0 ed)) "INSERT")
(setq nm (cdr (assoc 2 ed)))
(if (wcmatch (strcase nm) pat)
(setq n (1+ n))
(setq n (+ n (cs-count-nested nm pat)))))
)
(if (not stop) (setq e (entnext e)))
)
)
)
n
)
;;; ============================================================
;;; HAUPTBEFEHL
;;; ============================================================
(defun c:ZAEHLE_SEP_SCAN ( / ss i ent ed nm tags bb cx cy
carriers scanpts seppts kind pt
scanCounts sepCounts
rec en nm2 ns nsep internSep newS newP
n-scan-unassigned n-sep-unassigned
okS okP)
(setq carriers nil scanpts nil seppts nil)
;; Vor der Extents-Berechnung einmal regenerieren, damit
;; vla-getboundingbox verlaessliche Werte liefert.
(vl-catch-all-apply '(lambda () (command "_.REGEN")))
;; --- 1. Alle INSERTs sammeln und klassifizieren ---
(setq ss (ssget "_X" '((0 . "INSERT"))))
(if (null ss)
(progn (princ "\n>>> Keine Bloecke in der Zeichnung gefunden.") (princ))
(progn
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq ed (entget ent))
(setq nm (cdr (assoc 2 ed)))
(setq tags (cs-carrier-tags nm))
(cond
;; --- ILS-Block ---
(tags
(setq bb (cs-bbox ent))
(if bb
(progn
(setq cx (/ (+ (nth 0 bb) (nth 2 bb)) 2.0))
(setq cy (/ (+ (nth 1 bb) (nth 3 bb)) 2.0))
(setq carriers
(cons (list ent (car tags) (cadr tags)
(nth 0 bb) (nth 1 bb) (nth 2 bb) (nth 3 bb)
cx cy)
carriers)))
(princ (strcat "\n! Bounding-Box fehlgeschlagen fuer ILS-Block '" nm "'"
(if *cs-last-error*
(strcat " (" *cs-last-error* ")") "")))
)
)
;; --- Sensor ---
(t
(setq kind (cs-sensor-kind nm))
(if kind
(progn
(setq pt (cs-sensor-point ent ed kind))
(if (eq kind 'scanner)
(setq scanpts (cons pt scanpts))
(setq seppts (cons pt seppts)))))
)
)
(setq i (1+ i))
)
;; --- 2. Sensoren den ILS-Bloecken zuordnen ---
(setq scanCounts nil sepCounts nil
n-scan-unassigned 0 n-sep-unassigned 0)
(foreach pt scanpts
(setq rec (cs-assign pt carriers))
(if rec
(setq scanCounts (cs-bump scanCounts (car rec)))
(setq n-scan-unassigned (1+ n-scan-unassigned))))
(foreach pt seppts
(setq rec (cs-assign pt carriers))
(if rec
(setq sepCounts (cs-bump sepCounts (car rec)))
(setq n-sep-unassigned (1+ n-sep-unassigned))))
;; --- 3. Attribute setzen und Bericht ausgeben ---
(princ "\n============================================")
(princ "\n Sensor-Zaehlung je ILS-Block")
(princ "\n============================================")
(if (null carriers)
(princ "\n (Keine ILS-Bloecke KREISEL_/VF_/GF_ gefunden)")
(foreach rec carriers
(setq en (car rec))
(setq nm2 (cdr (assoc 2 (entget en))))
(setq ns (cond ((assoc en scanCounts) (cdr (assoc en scanCounts))) (t 0)))
(setq nsep (cond ((assoc en sepCounts) (cdr (assoc en sepCounts))) (t 0)))
;; interne Kette-Separatoren frisch aus der Blockdefinition zaehlen
(setq internSep (cs-count-nested nm2 *intern-separator-pattern*))
;; Scanner = nur neu zugeordnete
;; Separator = interne Kette-Separatoren + neu zugeordnete
(setq newS ns)
(setq newP (+ internSep nsep))
;; gefundene Anzahlen melden
(princ (strcat "\n " nm2
": Scanner(neu)=" (itoa ns)
", Separator intern=" (itoa internSep)
" + manuell=" (itoa nsep)))
;; Werte schreiben und Ergebnis bestaetigen
(setq okS (cs-set-att en (nth 1 rec) (itoa newS)))
(setq okP (cs-set-att en (nth 2 rec) (itoa newP)))
(if (and okS okP)
(princ (strcat "\n -> geschrieben: "
"ANZAHL_SCANNER=" (itoa newS)
", ANZAHL_SEPARATOR=" (itoa newP)))
(princ (strcat "\n -> FEHLER beim Schreiben: "
(if okS "" "ANZAHL_SCANNER fehlt ")
(if okP "" "ANZAHL_SEPARATOR fehlt"))))
)
)
(princ (strcat "\n--------------------------------------------"
"\n ILS-Bloecke gesamt: " (itoa (length carriers))
"\n Scanner gesamt: " (itoa (length scanpts))
" (nicht zugeordnet: " (itoa n-scan-unassigned) ")"
"\n Separator gesamt: " (itoa (length seppts))
" (nicht zugeordnet: " (itoa n-sep-unassigned) ")"))
(if (or (> n-scan-unassigned 0) (> n-sep-unassigned 0))
(princ (strcat "\n Hinweis: Nicht zugeordnete Sensoren liegen"
"\n ausserhalb aller ILS-Block-Boxen. Ggf. *senstol*"
"\n erhoehen oder Platzierung pruefen.")))
;; --- 4. Zeichnung speichern ---
(princ "\n--------------------------------------------")
(princ "\n Speichere Zeichnung (QSAVE) ...")
(command "_.QSAVE")
(princ "\n>>> Fertig.")
(princ)
)
)
(princ)
)
(princ "\n>>> count_sep_scan.lsp geladen. Befehl: ZAEHLE_SEP_SCAN")
(princ)
+38 -16
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)
) )
@@ -41,6 +41,14 @@
;; Beim Laden des Moduls einmalig einlesen (Lazy-Loading via ssg-ensure "export") ;; Beim Laden des Moduls einmalig einlesen (Lazy-Loading via ssg-ensure "export")
(export:load-cfg) (export:load-cfg)
;; --- Test-Override fuer den Ausgabeordner (nur Lisp-Sitzungsspeicher) ---
;; Wird ausschliesslich von TEST_EXPORT_ALL (tests/test_export_all.lsp)
;; waehrend des Testlaufs auf DXFM_TESTOUT gesetzt und danach garantiert
;; wieder auf nil zurueckgesetzt. Bewusst KEIN (setenv "DXFM_RESULTS" ...):
;; (setenv ...) schreibt in BricsCAD dauerhaft in die Profil-Registry und
;; ueberlebt damit jeden Neustart.
(setq *export-test-override* nil)
;; --- Feste Datei-/Skriptnamen dieses Moduls (keine Config, direkt im Code) --- ;; --- Feste Datei-/Skriptnamen dieses Moduls (keine Config, direkt im Code) ---
(setq *export-filenames* (setq *export-filenames*
@@ -196,32 +204,46 @@
;; py-name = Python-Skript-Name (z.B. "export_csv.py") ;; py-name = Python-Skript-Name (z.B. "export_csv.py")
;; csv-name = Ergebnis-CSV-Name (z.B. "export.csv") ;; csv-name = Ergebnis-CSV-Name (z.B. "export.csv")
(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) 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
;; (nur waehrend TEST_EXPORT_ALL, siehe tests/test_export_all.lsp).
;; WICHTIG: Hier bewusst KEIN (setenv "DXFM_RESULTS" ...) verwenden!
;; (setenv ...) schreibt in BricsCAD dauerhaft in die Profil-Registry
;; und ueberlebt damit jeden Neustart - ein einziger Testlauf wuerde
;; DXFM_RESULTS fuer alle zukuenftigen Sitzungen unwiderruflich auf den
;; Testordner umbiegen. *export-test-override* ist eine reine
;; Lisp-Variable (nur Prozess-/Sitzungsspeicher) und daher sicher.
(setq out-dir (if *export-test-override*
*export-test-override*
(getenv "DXFM_RESULTS")))
(if (not (vl-file-directory-p out-dir)) (vl-mkdir out-dir))
(princ (ssg-textf "exp-output-dir" (list label out-dir)))
;; JSON-Datei zusammenbauen ;; JSON-Datei zusammenbauen
(setq out-pfad (strcat (getenv "DXFM_RESULTS") "/" (setq out-pfad (strcat out-dir "/"
(export:filename "raw_json_datei"))) (export:filename "raw_json_datei")))
(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
@@ -238,22 +260,22 @@
) )
(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))
(if (findfile py-skript) (if (findfile py-skript)
(progn (progn
(setq ergebnis-pfad (strcat (getenv "DXFM_RESULTS") "/" csv-name)) (setq ergebnis-pfad (strcat out-dir "/" csv-name))
(setq cmd (strcat "python \"" py-skript "\"" (setq cmd (strcat "python \"" py-skript "\""
" \"" 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)))
) )
) )
) )
@@ -377,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)
@@ -396,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)
+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)
) )
+28 -12
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)
@@ -85,11 +85,11 @@
(if defa (if defa
(progn (progn
(initget 1 "Yes No Yes") (initget 1 "Yes No Yes")
(= (getkword (strcat "\n" prompt-text " Y/N <Y>: ")) "No") (= (getkword (strcat "\n" prompt-text (ssg-text "ques-yn-default-yes"))) "No")
) )
(progn (progn
(initget 1 "Yes No No") (initget 1 "Yes No No")
(= (getkword (strcat "\n" prompt-text " Y/N <N>: ")) "Yes") (= (getkword (strcat "\n" prompt-text (ssg-text "ques-yn-default-no"))) "Yes")
) )
) )
) )
@@ -126,12 +126,17 @@
) )
) )
;; Layer anlegen (falls nicht vorhanden) und optional setzen ;; Layer anlegen (falls nicht vorhanden) und optional aktivieren
;; lay-name = Name; color = Farbnummer als String z.B. "2"; set-aktiv = T/nil ;; lay-name = Name; color = Farbnummer als String z.B. "2"; set-aktiv = T/nil
(defun ssg-make-layer (lay-name color set-aktiv) ;; Farbe wird nur bei Neuanlage gesetzt, bestehende Layer bleiben unveraendert
(defun ssg-make-layer (lay-name color set-aktiv / neu)
(setq neu (not (tblsearch "LAYER" lay-name)))
(if set-aktiv (if set-aktiv
(command "_LAYER" "_M" lay-name "_CO" color lay-name "") (command "_LAYER" "_M" lay-name "")
(command "_LAYER" "_N" lay-name "_CO" color lay-name "") (command "_LAYER" "_N" lay-name "")
)
(if neu
(command "_LAYER" "_CO" color lay-name "")
) )
) )
@@ -225,7 +230,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 +465,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
@@ -536,8 +541,8 @@
(if (not (new_dialog dialog-name dat)) (if (not (new_dialog dialog-name dat))
(progn (alert "Dialog konnte nicht geladen werden.") (exit)) (progn (alert "Dialog konnte nicht geladen werden.") (exit))
) )
(if init-fn (init-fn)) (if init-fn (apply init-fn nil))
(action_tile "accept" "(if accept-fn (accept-fn)) (done_dialog 1)") (action_tile "accept" "(if accept-fn (apply accept-fn nil)) (done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)") (action_tile "cancel" "(done_dialog 0)")
(start_dialog) (start_dialog)
(unload_dialog dat) (unload_dialog dat)
@@ -733,6 +738,17 @@
((and (not in-section) (= trimmed "{")) nil) ((and (not in-section) (= trimmed "{")) nil)
((and (not in-section) (= trimmed "}")) nil) ((and (not in-section) (= trimmed "}")) nil)
;; Leere Section auf einer Zeile: "name": {}
;; (Section-Start und -Ende zugleich - json.dump schreibt leere
;; Objekte immer inline, unabhaengig von der Einrueckung.)
((and (not in-inner)
(>= (strlen trimmed) 2)
(= (substr trimmed (1- (strlen trimmed)) 2) "{}"))
(setq section (substr trimmed 2
(1- (vl-string-search "\"" trimmed 1))))
(setq ergebnis (cons (cons section nil) ergebnis))
)
;; Section-Start: "name": { ;; Section-Start: "name": {
((and (not in-inner) (vl-string-search ": {" trimmed)) ((and (not in-inner) (vl-string-search ": {" trimmed))
(setq kv (ssg-cfg-parse-kv (setq kv (ssg-cfg-parse-kv
+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)
+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)
+148
View File
@@ -0,0 +1,148 @@
;; ============================================================
;; SSG_LANG.LSP - Sprachumschaltung (Deutsch/Englisch)
;; Zentrale Textverwaltung fuer benutzersichtbare Meldungen.
;; Kern-Modul, wird direkt nach ssg_core geladen.
;;
;; Die Texte liegen extern in lang/de_DE.json und lang/en_GB.json.
;; Diese Datei ist reiner Lade-/Zugriffscode. Beim Laden wird
;; *ssg-texts* aus den JSON-Dateien befuellt - Format wie bisher:
;; (key (cons "de_DE" wert) (cons "en_GB" wert))
;; Die JSON-Dateien werden aus Lisp/ssg_lang.lsp einmalig per
;; tools/migrate_lang_to_json.py erzeugt und danach direkt gepflegt.
;; ============================================================
;; ------------------------------------------------------------
;; Alle Vorkommen von alt in str durch neu ersetzen.
;; Frueh definiert, da ssg-lang-unescape es beim Laden braucht.
;; ------------------------------------------------------------
(defun ssg-str-replace-all (neu alt str / pos ergebnis)
(setq ergebnis "")
(while (setq pos (vl-string-search alt str))
(setq ergebnis (strcat ergebnis (substr str 1 pos) neu))
(setq str (substr str (+ pos 1 (strlen alt))))
)
(strcat ergebnis str)
)
;; ------------------------------------------------------------
;; Sprachordner ermitteln: 1) DXFMAKRO env, 2) *ssg-lisp-pfad*, 3) nil.
;; Gleiches Fallback-Muster wie in Gefaellestrecke.lsp/KreiselInsert.lsp.
;; DXFM_LANG bleibt der Sprachcode und wird hier NICHT als Pfad genutzt.
;; ------------------------------------------------------------
(defun ssg-lang-dir ( / )
(cond
((and (getenv "DXFMAKRO") (= (type (getenv "DXFMAKRO")) 'STR)
(> (strlen (getenv "DXFMAKRO")) 0))
(strcat (vl-string-right-trim "/" (vl-string-translate "\\" "/" (getenv "DXFMAKRO")))
"/lang"))
((and (boundp '*ssg-lisp-pfad*) (= (type *ssg-lisp-pfad*) 'STR)
(vl-string-search "/Lisp" *ssg-lisp-pfad*))
(strcat (substr *ssg-lisp-pfad* 1 (vl-string-search "/Lisp" *ssg-lisp-pfad*))
"/lang"))
(t nil)
)
)
;; ------------------------------------------------------------
;; Escapes aus einem JSON-Rohwert aufloesen: \n -> Zeilenumbruch.
;; Der JSON-Parser (ssg-cfg-parse-nested) liefert \n als literale
;; 2-Zeichen-Folge (Backslash + n) zurueck; hier wird sie in einen
;; echten Zeilenumbruch gewandelt. Suchmuster ist "\\n" (= die zwei
;; Zeichen Backslash+n); "\n" waere bereits ein Zeilenumbruch.
;; Andere Escapes kommen in den Sprachdateien nicht vor.
;; ------------------------------------------------------------
(defun ssg-lang-unescape (wert)
(if wert
(ssg-str-replace-all (chr 10) "\\n" wert)
)
)
;; ------------------------------------------------------------
;; Beide Sprachdateien laden und *ssg-texts* im bisherigen Format
;; befuellen: (key (cons "de_DE" ...) (cons "en_GB" ...)).
;; Fehlt eine Datei oder ein Key, bleibt der jeweilige Wert nil -
;; die Fallback-Kette in ssg-text greift dann automatisch
;; (en_GB -> de_DE -> Key). BricsCAD startet in jedem Fall.
;; ------------------------------------------------------------
(defun ssg-lang-load ( / dir de-datei en-datei de-sec en-sec
key wert-de wert-en ergebnis)
(setq *ssg-texts* nil)
(setq dir (ssg-lang-dir))
(if (null dir)
(princ "\n[LANG] WARNUNG: Sprachordner nicht ermittelbar (DXFMAKRO nicht gesetzt).")
(progn
(setq de-datei (strcat dir "/de_DE.json")
en-datei (strcat dir "/en_GB.json"))
(if (findfile de-datei)
(setq de-sec (cdr (assoc "texts"
(ssg-cfg-parse-nested (ssg-read-file-lines de-datei)))))
(princ (strcat "\n[LANG] WARNUNG: " de-datei " nicht gefunden."))
)
(if (findfile en-datei)
(setq en-sec (cdr (assoc "texts"
(ssg-cfg-parse-nested (ssg-read-file-lines en-datei)))))
(princ (strcat "\n[LANG] WARNUNG: " en-datei " nicht gefunden."))
)
(foreach paar de-sec
(setq key (car paar)
wert-de (ssg-lang-unescape (cdr paar))
wert-en (ssg-lang-unescape (cdr (assoc key en-sec))))
(setq ergebnis
(cons (list key (cons "de_DE" wert-de) (cons "en_GB" wert-en)) ergebnis))
)
(setq *ssg-texts* (reverse ergebnis))
(princ (strcat "\n[LANG] " (itoa (length *ssg-texts*)) " Texte geladen."))
)
)
(princ)
)
;; ------------------------------------------------------------
;; AKTUELLE SPRACHE
;; Default de_DE, Init aus DXFM_LANG. Ein erneutes Laden dieses
;; Moduls ueberschreibt eine zur Laufzeit gesetzte Sprache nicht.
;; ------------------------------------------------------------
(if (null *ssg-lang*)
(setq *ssg-lang* (getenv "DXFM_LANG"))
)
(if (or (null *ssg-lang*) (= *ssg-lang* ""))
(setq *ssg-lang* "de_DE")
)
;; Texttabelle aus den JSON-Sprachdateien befuellen
(ssg-lang-load)
;; ------------------------------------------------------------
;; ssg-text - Text zu einem Key in der aktuellen Sprache liefern
;; Fallback-Kette: *ssg-lang* -> de_DE -> Key selbst
;; ------------------------------------------------------------
(defun ssg-text (key / eintrag wert)
(setq eintrag (assoc key *ssg-texts*))
(if eintrag
(progn
(setq wert (cdr (assoc *ssg-lang* (cdr eintrag))))
(if (null wert)
(setq wert (cdr (assoc "de_DE" (cdr eintrag))))
)
(if (null wert) key wert)
)
key
)
)
;; ssg-textf - Text mit Platzhaltern %1 %2 ... aus einer Werteliste fuellen
(defun ssg-textf (key werte / txt i platzhalter)
(setq txt (ssg-text key))
(setq i 1)
(foreach w werte
(setq platzhalter (strcat "%" (itoa i)))
(setq txt (ssg-str-replace-all (vl-princ-to-string w) platzhalter txt))
(setq i (1+ i))
)
txt
)
(princ)
+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)
) )
+2 -1
View File
@@ -24,6 +24,7 @@
) )
(load (strcat base-path "ssg_core.lsp") "ssg_core.lsp nicht gefunden") (load (strcat base-path "ssg_core.lsp") "ssg_core.lsp nicht gefunden")
(ssg-load-config) (ssg-load-config)
(load (strcat base-path "ssg_lang.lsp") "ssg_lang.lsp nicht gefunden")
(load (strcat base-path "ssg_dbg.lsp") "ssg_dbg.lsp nicht gefunden") (load (strcat base-path "ssg_dbg.lsp") "ssg_dbg.lsp nicht gefunden")
(load (strcat base-path "ssg_dialog.lsp") "ssg_dialog.lsp nicht gefunden") (load (strcat base-path "ssg_dialog.lsp") "ssg_dialog.lsp nicht gefunden")
(load (strcat base-path "ssg_layer.lsp") "ssg_layer.lsp nicht gefunden") (load (strcat base-path "ssg_layer.lsp") "ssg_layer.lsp nicht gefunden")
@@ -34,7 +35,7 @@
(load (strcat base-path "tests.lsp") "tests.lsp nicht gefunden") (load (strcat base-path "tests.lsp") "tests.lsp nicht gefunden")
(load (strcat base-path "OmniModulInsert.lsp") "OmniModulInsert.lsp nicht gefunden") (load (strcat base-path "OmniModulInsert.lsp") "OmniModulInsert.lsp nicht gefunden")
(load (strcat base-path "SSG_LIB_Commands.lsp") "SSG_LIB_Commands.lsp nicht gefunden") (load (strcat base-path "SSG_LIB_Commands.lsp") "SSG_LIB_Commands.lsp nicht gefunden")
(prompt "\nSSG-Bibliotheken geladen: ssg_core, ssg_dbg, ssg_dialog, ssg_layer, KreiselInsert, VarioFoerderer, Gefaellestrecke, export, tests, OmniModulInsert, SSG_LIB_Commands") (prompt "\nSSG-Bibliotheken geladen: ssg_core, ssg_lang, ssg_dbg, ssg_dialog, ssg_layer, KreiselInsert, VarioFoerderer, Gefaellestrecke, export, tests, OmniModulInsert, SSG_LIB_Commands")
(princ) (princ)
) )
+235 -141
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,33 +673,114 @@
(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))
;; ============================================================
;; AS-/ES-Element: Winkel-Variante (30 / 90 Grad)
;; ============================================================
;; Masse (KS_EIN->KS_AUS als (dx dy dz)) eines Elements aus dem Block ziehen.
(defun vf-element-masse (blockname / temp-obj ks-data ke ka)
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
nil
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0))
(setq ks-data (extract-ks-from-block temp-obj))
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
(setq ke (cadr (assoc "KS_EIN" ks-data)) ka (cadr (assoc "KS_AUS" ks-data)))
(if (and ke ka)
(list (- (caar ka) (caar ke))
(- (cadr (car ka)) (cadr (car ke)))
(- (caddr (car ka)) (caddr (car ke))))
nil))))
;; Ebenen-Schwenk (Grad) eines Elements: Winkel von KS_EIN.xu nach KS_AUS.xu in
;; der XY-Ebene, direkt aus dem Block gemessen (unabhaengig davon, ob 30/90-Turn
;; oder gerade). Wird genutzt, um KS_EIN so zu drehen, dass KS_AUS entlang hz
;; zeigt: ein-hz = hz - plan-turn. Fallback 90 (Vorgabe fuer 90-Grad-Element).
(defun vf-element-plan-turn (blockname / temp-obj ks-data fe fa)
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
90.0
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0))
(setq ks-data (extract-ks-from-block temp-obj))
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
(setq fe (ks-frame-extract (cadr (assoc "KS_EIN" ks-data))))
(setq fa (ks-frame-extract (cadr (assoc "KS_AUS" ks-data))))
(if (and fe fa)
(- (* (atan (cadr (cadr fa)) (car (cadr fa))) (/ 180.0 pi))
(* (atan (cadr (cadr fe)) (car (cadr fe))) (/ 180.0 pi)))
90.0))))
;; KS-Info eines Elements (im Block, Einbau-Rotation 0):
;; Rueckgabe (ein-ang aus-ang vx vy)
;; ein-ang / aus-ang : Ebenen-Winkel (Grad) von KS_EIN.xu bzw. KS_AUS.xu
;; vx / vy : KS_AUS.origin - KS_EIN.origin (Block-XY)
;; Damit laesst sich die KS_AUS-Lage + Achsrichtung analytisch vorausberechnen.
(defun vf-element-ks-info (blockname / temp-obj ks-data fe fa)
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
nil
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0))
(setq ks-data (extract-ks-from-block temp-obj))
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
(setq fe (ks-frame-extract (cadr (assoc "KS_EIN" ks-data))))
(setq fa (ks-frame-extract (cadr (assoc "KS_AUS" ks-data))))
(if (and fe fa)
(list (* (atan (cadr (cadr fe)) (car (cadr fe))) (/ 180.0 pi))
(* (atan (cadr (cadr fa)) (car (cadr fa))) (/ 180.0 pi))
(- (car (car fa)) (car (car fe)))
(- (cadr (car fa)) (cadr (car fe))))
nil))))
;; 30/90-Wahl fuer ein AS/ES-Element. Rueckgabe: "30" oder "90" (Vorgabe 90).
;; headerkey: i18n-Key fuer die Kopfzeile ("vf-winkel-aus-header" oder
;; "vf-winkel-ein-header"). Rueckgabe: "30" oder "90" (Default 90).
(defun vf-frage-element-winkel (headerkey)
(princ (ssg-text headerkey))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(if (= (getstring (ssg-text "prompt-wahl-1-2")) "2") "30" "90"))
;; AS-/ES-Masse-Globals (aus-dx/dy/dz bzw. ein-dx/dy/dz) fuer die gewaehlte
;; Winkel-/Seiten-Variante neu setzen (fuer berechne-alle-winkel, GF-Winkel,
;; Trimmungen). Ohne gueltigen Block bleiben die Werte unveraendert.
(defun vf-set-as-masse (winkel seite / m)
(setq m (vf-element-masse (strcat "AS_Element_" winkel "_" seite)))
(if m (setq aus-dx (car m) aus-dy (cadr m) aus-dz (caddr m))))
(defun vf-set-es-masse (winkel seite / m)
(setq m (vf-element-masse (strcat "ES_Element_" winkel "_" seite)))
(if m (setq ein-dx (car m) ein-dy (cadr m) ein-dz (caddr m))))
;; hz: horizontale Fahrtrichtung in Grad (0=Ost/+X, 90=Nord/+Y, ...), ;; hz: horizontale Fahrtrichtung in Grad (0=Ost/+X, 90=Nord/+Y, ...),
;; winkel: vertikale Neigung in Grad. Rotation = Rz(hz)*Ry(winkel). ;; winkel: vertikale Neigung in Grad. Rotation = Rz(hz)*Ry(winkel).
(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 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 +802,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 +831,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 +899,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 +912,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 +941,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 +961,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 +1007,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; "
@@ -1081,9 +1150,10 @@
;; 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 vf-insert)) (ssg-id-generate vf-insert))
(princ (strcat "\n>>> Block '" vf-bname "' erstellt und eingefuegt.")) (princ (ssg-textf "vfc-block-erstellt-eingefuegt" (list vf-bname)))
vf-insert
) )
(princ "\n>>> FEHLER: Keine Entities fuer Block gefunden!") (progn (princ (ssg-text "vfc-fehler-keine-entities")) nil)
) )
) )
@@ -1129,13 +1199,13 @@
staustrecke-basis) staustrecke-basis)
(princ "\n=========================================") (princ "\n=========================================")
(princ "\n VARIOFOERDERER GENERATOR v26.0") (princ (ssg-text "vfc-banner-titel"))
(princ "\n=========================================") (princ "\n=========================================")
;; 1. Typ aus Registry waehlen ;; 1. Typ aus Registry waehlen
(if (null *vf-typ-registry*) (if (null *vf-typ-registry*)
(progn (progn
(alert "Keine Typen registriert!\nvf_standard.lsp und vf_etage.lsp pruefen.") (alert (ssg-text "vfc-alert-keine-typen"))
(exit) (exit)
) )
) )
@@ -1143,19 +1213,19 @@
(if (and *vf-vorauswahl-typ* (assoc *vf-vorauswahl-typ* *vf-typ-registry*)) (if (and *vf-vorauswahl-typ* (assoc *vf-vorauswahl-typ* *vf-typ-registry*))
(progn (progn
(setq typ-eintr (assoc *vf-vorauswahl-typ* *vf-typ-registry*)) (setq typ-eintr (assoc *vf-vorauswahl-typ* *vf-typ-registry*))
(princ (strcat "\n>>> Typ vorgewaehlt: " *vf-vorauswahl-typ*)) (princ (ssg-textf "vfc-typ-vorgewaehlt" (list *vf-vorauswahl-typ*)))
(setq *vf-vorauswahl-typ* nil) (setq *vf-vorauswahl-typ* nil)
) )
(progn (progn
(setq *vf-vorauswahl-typ* nil) (setq *vf-vorauswahl-typ* nil)
(princ "\n\nAnlagen-Typ waehlen:") (princ (ssg-text "vfc-anlagen-typ-header"))
(setq idx 1) (setq idx 1)
(foreach eintr *vf-typ-registry* (foreach eintr *vf-typ-registry*
(princ (strcat "\n " (itoa idx) " - " (nth 3 eintr))) (princ (ssg-textf "vfc-typ-option" (list idx (nth 3 eintr))))
(setq idx (1+ idx)) (setq idx (1+ idx))
) )
(setq wahl (getint (strcat "\nIhre Wahl (1-" (setq wahl (getint (ssg-textf "vfc-prompt-wahl-1-n"
(itoa (length *vf-typ-registry*)) ") [1]: "))) (list (length *vf-typ-registry*)))))
(if (or (null wahl) (< wahl 1) (> wahl (length *vf-typ-registry*))) (if (or (null wahl) (< wahl 1) (> wahl (length *vf-typ-registry*)))
(setq wahl 1)) (setq wahl 1))
(setq typ-eintr (nth (1- wahl) *vf-typ-registry*)) (setq typ-eintr (nth (1- wahl) *vf-typ-registry*))
@@ -1164,7 +1234,7 @@
(setq anlage-typ (nth 0 typ-eintr)) (setq anlage-typ (nth 0 typ-eintr))
(setq berechne-fn (nth 1 typ-eintr)) (setq berechne-fn (nth 1 typ-eintr))
(setq einfuege-fn (nth 2 typ-eintr)) (setq einfuege-fn (nth 2 typ-eintr))
(princ (strcat "\n>>> Typ: " anlage-typ)) (princ (ssg-textf "vfc-typ-gewaehlt" (list anlage-typ)))
;; Sonderfall "linienzug": eigener Befehlsablauf (interaktive Mehrsegment- ;; Sonderfall "linienzug": eigener Befehlsablauf (interaktive Mehrsegment-
;; Kette mit gemischten GF/VF-Segmenten), passt nicht in das berechne-fn/ ;; Kette mit gemischten GF/VF-Segmenten), passt nicht in das berechne-fn/
@@ -1172,14 +1242,44 @@
;; vf_linienzug.lsp. Dispatcht hier direkt und beendet den Standard-Ablauf. ;; vf_linienzug.lsp. Dispatcht hier direkt und beendet den Standard-Ablauf.
(if (= anlage-typ "linienzug") (if (= anlage-typ "linienzug")
(progn (progn
(vf-linienzug-modus) (princ "\n\nLinienzug-Modus waehlen:")
(princ "\n 1 - Manuelle Eingabe (Punkte klicken)")
(princ "\n 2 - 3D-Objekte + Ziel-Hoehe (Randwert-Solver, fertig)")
(princ "\n 3 - 3D-Objekte stueckweise (Vorwaerts-Nachbau, in Arbeit)")
(setq wahl (getint "\nIhre Wahl (1/2/3) [1]: "))
;; Konsolen-Nummer -> interne Funktion:
;; 2 = fertiger Ziel-Hoehe-Modus (intern vf-linienzug-modus2)
;; 3 = alter Vorwaerts-Nachbau (intern vf-linienzug-modus3, wird umgebaut)
(cond ((= wahl 2) (vf-linienzug-modus2))
((= wahl 3) (vf-linienzug-modus3))
(t (vf-linienzug-modus)))
(exit) (exit)
) )
) )
;; 2. VF-Nummer automatisch ermitteln ;; 2. VF-Nummer automatisch ermitteln
(setq vf-nummer (vf-next-number)) (setq vf-nummer (vf-next-number))
(princ (strcat "\n>>> Naechste VF-Nummer: VF" (itoa vf-nummer))) (princ (ssg-textf "vfc-naechste-vf-nummer" (list (itoa vf-nummer))))
;; 2b. Standardfall (anlage-typ "standard") + Werteingabe -> DCL-Dialog
;; (dcl/variofoerderer.dcl, siehe vf_standard.lsp: vfs-standard-dialog-ablauf).
;; 3D-Linie-Eingabe und alle anderen Anlagen-Typen (Etage, Linienzug) bleiben
;; unveraendert interaktiv (fallen unten in den bestehenden Konsolen-Ablauf,
;; der die Eingabemodus-Frage dabei erneut stellt - siehe vf-eingabe-abfragen).
(if (= anlage-typ "standard")
(progn
(princ (ssg-text "vfc-eingabemodus-header"))
(princ (ssg-text "vfc-eingabemodus-3dlinie"))
(princ (ssg-text "vfc-eingabemodus-werte"))
(setq antwort (getstring (ssg-text "vfc-prompt-wahl-1-2-ohne-default")))
(if (= antwort "2")
(progn
(vfs-standard-dialog-ablauf vf-nummer)
(exit)
)
)
)
)
;; 3. Gemeinsame Eingabe (deltaL, deltaH, richtung, startpunkt) - richtung ;; 3. Gemeinsame Eingabe (deltaL, deltaH, richtung, startpunkt) - richtung
;; steht bei beiden Eingabemodi (Werteingabe UND 3D-Linie) bereits fest. ;; steht bei beiden Eingabemodi (Werteingabe UND 3D-Linie) bereits fest.
@@ -1192,12 +1292,12 @@
eingabe-modus (nth 5 eingabe)) eingabe-modus (nth 5 eingabe))
;; 4. Seite-Auswahl (vor Berechnung, weil Etage-Typ sie fuer Geometrie braucht) ;; 4. Seite-Auswahl (vor Berechnung, weil Etage-Typ sie fuer Geometrie braucht)
(princ "\n\nSeite waehlen:") (princ (ssg-text "vfc-seite-header"))
(princ "\n 1 - Rechts") (princ (ssg-text "vfc-seite-rechts"))
(princ "\n 2 - Links") (princ (ssg-text "vfc-seite-links"))
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: ")) (setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(if (= antwort "2") (setq seite "links") (setq seite "rechts")) (if (= antwort "2") (setq seite "links") (setq seite "rechts"))
(princ (strcat "\n>>> Seite: " seite)) (princ (ssg-textf "vfc-seite-gewaehlt" (list seite)))
;; 5. Typ-spezifische Berechnung (init + Winkelsuche) ;; 5. Typ-spezifische Berechnung (init + Winkelsuche)
(setq ergebnis (apply berechne-fn (list deltaL deltaH richtung seite))) (setq ergebnis (apply berechne-fn (list deltaL deltaH richtung seite)))
@@ -1216,7 +1316,7 @@
(setq ergebnis-liste (setq ergebnis-liste
(append ergebnis-liste (append ergebnis-liste
(list (list 0 (car horizontal-info) (cadr horizontal-info) T)))) (list (list 0 (car horizontal-info) (cadr horizontal-info) T))))
(princ "\n\n>>> Hinweis: Ein horizontale Variofoerderer ( 0°) ist bei diesem △L/△H zusaetzlich moeglich!") (princ (ssg-textf "vfc-hinweis-horizontal-moeglich" (list (chr 176) (chr 916))))
) )
(setq horizontal-info nil) (setq horizontal-info nil)
) )
@@ -1236,9 +1336,8 @@
ergebnis-liste))) ergebnis-liste)))
(if (null gueltige-winkel) (if (null gueltige-winkel)
(progn (progn
(alert (strcat "Kein passender Winkel gefunden!\n" (alert (ssg-textf "vfc-alert-kein-winkel"
"△L=" (rtos deltaL 2 0) " mm, △H=" (list (chr 916) (rtos deltaL 2 0) (rtos deltaH 2 0) richtung)))
(rtos deltaH 2 0) " mm, Richtung=" richtung))
(exit) (exit)
) )
) )
@@ -1252,29 +1351,27 @@
(setq eintrag (assoc best-winkel ergebnis-liste)) (setq eintrag (assoc best-winkel ergebnis-liste))
(setq L_GF (nth 1 eintrag) L_VF (nth 2 eintrag)) (setq L_GF (nth 1 eintrag) L_VF (nth 2 eintrag))
(if (= best-winkel 0) (if (= best-winkel 0)
(princ "\n\n>>> Einzige gueltige Variante: Horizontale Variofoerderer") (princ (ssg-text "vfc-einzige-variante-horizontal"))
(princ (strcat "\n\n>>> Einziger gueltiger Winkel: " (princ (ssg-textf "vfc-einziger-winkel" (list (itoa best-winkel) (chr 176))))
(itoa best-winkel) (chr 176)))
) )
) )
(progn (progn
(princ "\n\nMehrere gueltige Winkel verfuegbar. Bitte waehlen:") (princ (ssg-text "vfc-mehrere-winkel-header"))
(setq idx 1) (setq idx 1)
(foreach w gueltige-winkel (foreach w gueltige-winkel
(setq eintrag (assoc w ergebnis-liste)) (setq eintrag (assoc w ergebnis-liste))
(if (= w 0) (if (= w 0)
(princ (strcat "\n " (itoa idx) " - Horizontale Variofoerderer (0" (princ (ssg-textf "vfc-winkel-option-horizontal"
(chr 176) ")" (list idx (chr 176)
" (L_GF=" (rtos (nth 1 eintrag) 2 1) (rtos (nth 1 eintrag) 2 1) (rtos (nth 2 eintrag) 2 1))))
" mm, L_VF=" (rtos (nth 2 eintrag) 2 1) " mm)")) (princ (ssg-textf "vfc-winkel-option"
(princ (strcat "\n " (itoa idx) " - " (itoa w) (chr 176) (list idx (itoa w) (chr 176)
" (L_GF=" (rtos (nth 1 eintrag) 2 1) (rtos (nth 1 eintrag) 2 1) (rtos (nth 2 eintrag) 2 1))))
" mm, L_VF=" (rtos (nth 2 eintrag) 2 1) " mm)"))
) )
(setq idx (1+ idx)) (setq idx (1+ idx))
) )
(setq wahl (getint (strcat "Winkel waehlen (1-" (setq wahl (getint (ssg-textf "vfc-prompt-winkel-waehlen"
(itoa (length gueltige-winkel)) ") [1]: "))) (list (length gueltige-winkel)))))
(if (or (null wahl) (< wahl 1) (> wahl (length gueltige-winkel))) (if (or (null wahl) (< wahl 1) (> wahl (length gueltige-winkel)))
(setq wahl 1)) (setq wahl 1))
(setq best-winkel (nth (1- wahl) gueltige-winkel)) (setq best-winkel (nth (1- wahl) gueltige-winkel))
@@ -1284,22 +1381,20 @@
) )
(princ "\n\n=========================================") (princ "\n\n=========================================")
(if (= best-winkel 0) (if (= best-winkel 0)
(princ (strcat "\n>>> Horizontale Variofoerderer" (princ (ssg-textf "vfc-zus-horizontal"
" L_GF: " (rtos L_GF 2 2) " mm" (list (rtos L_GF 2 2) (rtos L_VF 2 2))))
" L_VF: " (rtos L_VF 2 2) " mm")) (princ (ssg-textf "vfc-zus-winkel"
(princ (strcat "\n>>> Winkel: " (itoa best-winkel) (chr 176) (list (itoa best-winkel) (chr 176) (rtos L_GF 2 2) (rtos L_VF 2 2))))
" L_GF: " (rtos L_GF 2 2) " mm"
" L_VF: " (rtos L_VF 2 2) " mm"))
) )
(princ "\n=========================================") (princ "\n=========================================")
;; 9. L_GF Verteilung ;; 9. L_GF Verteilung
(princ "\n\nVerteilung der Gefaellestrecken (vorne/hinten):") (princ (ssg-text "vfc-gf-verteilung-header"))
(princ "\n 1 - Gleichmaessig (L_GF1 = L_GF2 = L_GF/2)") (princ (ssg-text "vfc-gf-verteilung-1"))
(princ "\n 2 - Vorne Minimum, hinten Rest") (princ (ssg-text "vfc-gf-verteilung-2"))
(princ "\n 3 - Hinten Minimum, vorne Rest") (princ (ssg-text "vfc-gf-verteilung-3"))
(princ "\n 4 - Eigene Werte eingeben") (princ (ssg-text "vfc-gf-verteilung-4"))
(setq verteilung-modus (getstring "\nIhre Wahl (1/2/3/4) [1]: ")) (setq verteilung-modus (getstring (ssg-text "prompt-wahl-1-2-3-4")))
(if (= verteilung-modus "") (setq verteilung-modus "1")) (if (= verteilung-modus "") (setq verteilung-modus "1"))
(cond (cond
((= verteilung-modus "1") ((= verteilung-modus "1")
@@ -1311,23 +1406,22 @@
(setq L_GF2 (float staustrecke-basis)) (setq L_GF2 (float staustrecke-basis))
(setq L_GF1 (max 0.0 (- L_GF (float staustrecke-basis))))) (setq L_GF1 (max 0.0 (- L_GF (float staustrecke-basis)))))
((= verteilung-modus "4") ((= verteilung-modus "4")
(setq L_GF1 (getreal (strcat "\nL_GF1 vorne (mm) [" (setq L_GF1 (getreal (ssg-textf "vfc-prompt-lgf1-vorne"
(rtos (/ L_GF 2.0) 2 2) "]: "))) (list (rtos (/ L_GF 2.0) 2 2)))))
(if (null L_GF1) (setq L_GF1 (/ L_GF 2.0))) (if (null L_GF1) (setq L_GF1 (/ L_GF 2.0)))
(setq L_GF2 (max 0.0 (- L_GF L_GF1))) (setq L_GF2 (max 0.0 (- L_GF L_GF1)))
(princ (strcat "\n L_GF2 hinten: " (rtos L_GF2 2 2) " mm"))) (princ (ssg-textf "vfc-lgf2-hinten" (list (rtos L_GF2 2 2)))))
(t (setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0))) (t (setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
) )
(princ (strcat "\n>>> L_GF1=" (rtos L_GF1 2 2) (princ (ssg-textf "vfc-zus-lgf" (list (rtos L_GF1 2 2) (rtos L_GF2 2 2))))
" mm L_GF2=" (rtos L_GF2 2 2) " mm"))
;; Scanner-Anzahl wird nicht mehr abgefragt (Attribut ANZAHL_SCANNER bleibt 0). ;; Scanner-Anzahl wird nicht mehr abgefragt (Attribut ANZAHL_SCANNER bleibt 0).
(setq n-scanner 0) (setq n-scanner 0)
;; 11. Bestaetigung ;; 11. Bestaetigung
(princ "\n\nMoechten Sie die Foerderanlage einfuegen?") (princ (ssg-text "vfc-einfuegen-frage"))
(princ "\n 1 - Ja, Module einfuegen\n 2 - Nein, abbrechen") (princ (ssg-text "vfc-einfuegen-optionen"))
(setq antwort (getstring "\nIhre Wahl (1/2): ")) (setq antwort (getstring (ssg-text "vfc-prompt-wahl-1-2-ohne-default")))
(if (= antwort "1") (if (= antwort "1")
(progn (progn
@@ -1352,7 +1446,7 @@
(princ "\n=========================================") (princ "\n=========================================")
) )
(princ "\nVorgang abgebrochen.") (princ (ssg-text "vfc-vorgang-abgebrochen"))
) )
nil nil
) )
+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
+1119 -110
View File
File diff suppressed because it is too large Load Diff
+463 -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))
@@ -706,6 +699,427 @@
endpunkt endpunkt
) )
;; ============================================================
;; DCL-DIALOG (Standardfall) - dcl/variofoerderer.dcl
;; Ersetzt die interaktive Werteingabe aus vf-eingabe-abfragen
;; (Konsolen-Modus "Werteingabe") fuer anlage-typ "standard" durch
;; zwei DCL-Dialoge: Basis-Eingabe und Winkel/Verteilung. Die
;; 3D-Linie-Eingabe sowie die Typen "etage"/"linienzug" bleiben
;; unveraendert interaktiv (siehe Verzweigung in c:VarioFoerderer).
;; ============================================================
;; Basis-Eingabe (Dialog 1): deltaL, deltaH, Richtung, Einfuegehoehe,
;; Fahrtrichtung, Seite.
;; prefill: Assoziationsliste zur Vorbelegung (fuer VARIOFOERDERER_EDIT) mit
;; Schluesseln "deltaL" "deltaH" "richtung" "einfuegehoehe" "hz" "seite"
;; - oder nil fuer Neuanlage mit Defaults.
;; Rueckgabe: (deltaL deltaH richtung einfuegehoehe hz seite) oder nil bei Abbruch.
(defun vfs-dialog-eingabe-basis (prefill / dcl-pfad dat ergebnis
dlg-deltal dlg-deltah dlg-richtung dlg-hoehe
dlg-fahrtrichtung dlg-seite
deltaL deltaH richtung hz seite z-start)
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/variofoerderer.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "variofoerderer_basis" dat))
(progn
(if (>= dat 0) (unload_dialog dat))
(alert (ssg-textf "gf-alert-dialog-fehlt" (list dcl-pfad)))
nil
)
(progn
;; Vorbelegung: aus prefill (Edit) oder Defaults (Neuanlage)
(set_tile "deltal"
(if prefill (rtos (cdr (assoc "deltaL" prefill)) 2 0) "15000"))
(set_tile "deltah"
(if prefill (rtos (cdr (assoc "deltaH" prefill)) 2 0) "3000"))
(set_tile "einfuegehoehe"
(if prefill (rtos (cdr (assoc "einfuegehoehe" prefill)) 2 1) "0"))
(start_list "richtung")
(add_list (ssg-text "vfs-dlg-richtung-auf"))
(add_list (ssg-text "vfs-dlg-richtung-ab"))
(end_list)
(set_tile "richtung"
(if (and prefill (equal (cdr (assoc "richtung" prefill)) "Ab")) "1" "0"))
(start_list "fahrtrichtung")
(add_list (ssg-textf "gf-dlg-richtung-0" (list grad-zeichen)))
(add_list (ssg-textf "gf-dlg-richtung-90" (list grad-zeichen)))
(add_list (ssg-textf "gf-dlg-richtung-180" (list grad-zeichen)))
(add_list (ssg-textf "gf-dlg-richtung-270" (list grad-zeichen)))
(end_list)
(set_tile "fahrtrichtung"
(if prefill
(cond ((equal (cdr (assoc "hz" prefill)) 90.0 0.1) "1")
((equal (cdr (assoc "hz" prefill)) 180.0 0.1) "2")
((equal (cdr (assoc "hz" prefill)) 270.0 0.1) "3")
(t "0"))
"0"))
(start_list "seite")
(add_list (ssg-text "gf-dlg-rechts"))
(add_list (ssg-text "gf-dlg-links"))
(end_list)
(set_tile "seite"
(if (and prefill (equal (cdr (assoc "seite" prefill)) "links")) "1" "0"))
;; Actions
(action_tile "accept"
(strcat
"(setq dlg-deltal (get_tile \"deltal\"))"
"(setq dlg-deltah (get_tile \"deltah\"))"
"(setq dlg-richtung (get_tile \"richtung\"))"
"(setq dlg-hoehe (get_tile \"einfuegehoehe\"))"
"(setq dlg-fahrtrichtung (get_tile \"fahrtrichtung\"))"
"(setq dlg-seite (get_tile \"seite\"))"
"(done_dialog 1)"
)
)
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(if (= ergebnis 1)
(progn
(setq deltaL (atof dlg-deltal))
(setq deltaH (atof dlg-deltah))
(setq richtung (if (= dlg-richtung "1") "Ab" "Auf"))
(setq z-start (atof dlg-hoehe))
(setq hz
(cond ((= dlg-fahrtrichtung "1") 90.0)
((= dlg-fahrtrichtung "2") 180.0)
((= dlg-fahrtrichtung "3") 270.0)
(t 0.0)))
(setq seite (if (= dlg-seite "1") "links" "rechts"))
(list deltaL deltaH richtung z-start hz seite)
)
nil
)
)
)
)
;; Winkel/Verteilung-Eingabe (Dialog 2): Winkel-Popup aus den vorher
;; berechneten gueltigen Varianten (gueltige-winkel/ergebnis-liste, siehe
;; berechne-alle-winkel), plus L_GF-Verteilung vorne/hinten (analog Schritt
;; 8+9 in c:VarioFoerderer).
;; prefill: Assoziationsliste ("winkel" . best-winkel) ("verteilung-idx" . "0".."3")
;; ("lgf1" . mm) - oder nil fuer Vorbelegung mit dem kleinsten gueltigen Winkel.
;; Rueckgabe: (best-winkel L_GF L_VF L_GF1 L_GF2 verteilung-modus) oder nil bei Abbruch.
(defun vfs-dialog-winkel-verteilung (gueltige-winkel ergebnis-liste staustrecke-basis prefill /
dcl-pfad dat ergebnis w eintrag idx sel-idx init-verteilung
dlg-winkel dlg-verteilung dlg-lgf1
best-winkel L_GF L_VF verteilung-modus L_GF1 L_GF2)
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/variofoerderer.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "variofoerderer_winkel" dat))
(progn
(if (>= dat 0) (unload_dialog dat))
(alert (ssg-textf "gf-alert-dialog-fehlt" (list dcl-pfad)))
nil
)
(progn
;; Winkel-Popup aus den gueltigen Varianten aufbauen
(start_list "winkel")
(foreach w gueltige-winkel
(setq eintrag (assoc w ergebnis-liste))
(if (= w 0)
(add_list (ssg-textf "vfs-dlg-winkel-horizontal"
(list (rtos (nth 1 eintrag) 2 1) (rtos (nth 2 eintrag) 2 1))))
(add_list (ssg-textf "vfs-dlg-winkel-option"
(list (itoa w) grad-zeichen (rtos (nth 1 eintrag) 2 1) (rtos (nth 2 eintrag) 2 1))))
)
)
(end_list)
;; Vorbelegung: Winkel aus prefill (falls noch gueltig), sonst erster
;; (kleinster) gueltiger Winkel - analog der automatischen Konsolen-Wahl.
(setq sel-idx 0 idx 0)
(if prefill
(foreach w gueltige-winkel
(if (equal w (cdr (assoc "winkel" prefill))) (setq sel-idx idx))
(setq idx (1+ idx))
)
)
(set_tile "winkel" (itoa sel-idx))
;; Verteilung: Popup + manuelles L_GF1-Feld (nur bei "Eigene Werte" aktiv)
(start_list "verteilung")
(add_list (ssg-text "vfs-dlg-verteilung-1"))
(add_list (ssg-text "vfs-dlg-verteilung-2"))
(add_list (ssg-text "vfs-dlg-verteilung-3"))
(add_list (ssg-text "vfs-dlg-verteilung-4"))
(end_list)
(setq init-verteilung (if prefill (cdr (assoc "verteilung-idx" prefill)) "0"))
(set_tile "verteilung" init-verteilung)
(set_tile "lgf1_manuell"
(if (and prefill (cdr (assoc "lgf1" prefill)))
(rtos (cdr (assoc "lgf1" prefill)) 2 1) "0"))
(mode_tile "lgf1_manuell" (if (= init-verteilung "3") 0 1))
(action_tile "verteilung"
"(mode_tile \"lgf1_manuell\" (if (= (get_tile \"verteilung\") \"3\") 0 1))")
(action_tile "accept"
(strcat
"(setq dlg-winkel (get_tile \"winkel\"))"
"(setq dlg-verteilung (get_tile \"verteilung\"))"
"(setq dlg-lgf1 (get_tile \"lgf1_manuell\"))"
"(done_dialog 1)"
)
)
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(if (= ergebnis 1)
(progn
(setq best-winkel (nth (atoi dlg-winkel) gueltige-winkel))
(setq eintrag (assoc best-winkel ergebnis-liste))
(setq L_GF (nth 1 eintrag) L_VF (nth 2 eintrag))
(setq verteilung-modus dlg-verteilung)
(cond
((= verteilung-modus "0")
(setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
((= verteilung-modus "1")
(setq L_GF1 (float staustrecke-basis))
(setq L_GF2 (max 0.0 (- L_GF (float staustrecke-basis)))))
((= verteilung-modus "2")
(setq L_GF2 (float staustrecke-basis))
(setq L_GF1 (max 0.0 (- L_GF (float staustrecke-basis)))))
((= verteilung-modus "3")
(setq L_GF1 (atof dlg-lgf1))
(if (or (null L_GF1) (< L_GF1 0)) (setq L_GF1 (/ L_GF 2.0)))
(if (> L_GF1 L_GF) (setq L_GF1 L_GF))
(setq L_GF2 (max 0.0 (- L_GF L_GF1))))
(t (setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
)
(list best-winkel L_GF L_VF L_GF1 L_GF2 verteilung-modus)
)
nil
)
)
)
)
;; ============================================================
;; XDATA-Metadaten fuer den Edit-Nachbau (App "SSG_VF_EDIT").
;; Markiert ein VF_n-INSERT als "mit dem Standard-Dialog erstellt" und
;; speichert die Fahrtrichtung (hz) - der einzige Wert, der sich nicht aus
;; den Sivas-Attributen rekonstruieren laesst (ANTRIEBFAHRTRICHTUNG, SEITE_AS,
;; VF_WINKEL, L_GF_m stehen dort bereits). Bewusst NICHT im Sivas-Attributsatz.
;; Ohne diese Markierung (z.B. Etage-, Linienzug- oder Altbestand-Bloecke)
;; verweigert c:VARIOFOERDERER_EDIT die Bearbeitung, um deren komplexere
;; Geometrie nicht versehentlich durch einen einfachen Neuaufbau zu ersetzen.
;; ============================================================
(if (null *vf-xdata-app*) (setq *vf-xdata-app* "SSG_VF_EDIT"))
(defun vfs-xdata-schreiben (ent hz /)
(regapp *vf-xdata-app*)
(entmod
(append (entget ent)
(list
(list -3
(list *vf-xdata-app*
(cons 1000 "standard")
(cons 1000 (rtos (float hz) 2 4)))))))
ent
)
;; XDATA lesen -> (typ-marker hz-str) oder nil.
(defun vfs-xdata-lesen (ent / xd app-data)
(setq xd (entget ent (list *vf-xdata-app*)))
(setq app-data (cdr (assoc -3 xd)))
(if app-data
(mapcar 'cdr (cdr (car app-data)))
nil
)
)
;; ============================================================
;; Gemeinsame Berechnung + Winkel/Verteilung-Dialog + Einfuegung.
;; Wird sowohl von der Neuanlage (vfs-standard-dialog-ablauf) als auch vom
;; Edit-Befehl (c:VARIOFOERDERER_EDIT) verwendet.
;; winkel-prefill: Vorbelegung fuer vfs-dialog-winkel-verteilung oder nil.
;; ============================================================
(defun vfs-standard-dialog-berechnen-einfuegen (vf-nummer deltaL deltaH richtung startpunkt hz seite
winkel-prefill /
ergebnis ergebnis-liste gueltige-winkel horizontal-info
winkelwahl best-winkel L_GF L_VF L_GF1 L_GF2 verteilung-modus
n-scanner hoehe-von hoehe-bis lastEnt vf-insert staustrecke-basis)
(setq ergebnis (berechne-standard deltaL deltaH richtung seite))
(setq ergebnis-liste (cadddr ergebnis))
(setq staustrecke-basis (ssg-cfg-or "vario" "staustrecke_basis" 1000))
;; Horizontale Zwischenstrecke als Zusatzoption (nur bei "Ab" erreichbar,
;; siehe Kommentar in c:VarioFoerderer Schritt 5b).
(setq horizontal-info nil)
(if (= richtung "Ab")
(progn
(setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab"))
(if (and horizontal-info (caddr horizontal-info))
(setq ergebnis-liste
(append ergebnis-liste (list (list 0 (car horizontal-info) (cadr horizontal-info) T))))
(setq horizontal-info nil)
)
)
)
(setq gueltige-winkel
(mapcar 'car
(vl-remove-if-not
(function (lambda (e) (and (nth 3 e) (numberp (nth 1 e)) (numberp (nth 2 e))
(>= (nth 1 e) 0) (>= (nth 2 e) 0))))
ergebnis-liste)))
(if (null gueltige-winkel)
(alert (ssg-textf "vfc-alert-kein-winkel"
(list (chr 916) (rtos deltaL 2 0) (rtos deltaH 2 0) richtung)))
(progn
(setq winkelwahl (vfs-dialog-winkel-verteilung gueltige-winkel ergebnis-liste staustrecke-basis winkel-prefill))
(if (null winkelwahl)
(princ (ssg-text "vfc-vorgang-abgebrochen"))
(progn
(setq best-winkel (nth 0 winkelwahl)
L_GF (nth 1 winkelwahl)
L_VF (nth 2 winkelwahl)
L_GF1 (nth 3 winkelwahl)
L_GF2 (nth 4 winkelwahl)
verteilung-modus (nth 5 winkelwahl))
(setq n-scanner 0)
(setq hoehe-von (caddr startpunkt))
(setq hoehe-bis
(cond ((= richtung "Auf") (+ hoehe-von deltaH))
((= richtung "Ab") (- hoehe-von deltaH))
(t hoehe-von)))
(setq lastEnt (vf-lastent-ohne-attribute))
(variofoerderer-einfuegen deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite hz)
(setq vf-insert
(vf-block-erstellen "standard" seite vf-nummer n-scanner
hoehe-von hoehe-bis deltaH deltaL L_VF L_GF1 L_GF2
richtung best-winkel startpunkt lastEnt hz))
(if vf-insert (vfs-xdata-schreiben vf-insert hz))
(princ "\n=========================================")
)
)
)
)
)
;; Neuanlage (Menue/Konsole -> Dialog): Startpunkt (X/Y) picken, Basis-Dialog,
;; dann gemeinsame Berechnung/Winkel-Dialog/Einfuegung.
(defun vfs-standard-dialog-ablauf (vf-nummer / eingabe deltaL deltaH richtung
z-start hz seite startpunkt startpunkt-xy)
(setq startpunkt-xy (getpoint (ssg-text "vfc-prompt-startpunkt-aus")))
(if (null startpunkt-xy) (setq startpunkt-xy '(0 0 0)))
(setq eingabe (vfs-dialog-eingabe-basis nil))
(if (null eingabe)
(princ (ssg-text "vfc-vorgang-abgebrochen"))
(progn
(setq deltaL (nth 0 eingabe)
deltaH (nth 1 eingabe)
richtung (nth 2 eingabe)
z-start (nth 3 eingabe)
hz (nth 4 eingabe)
seite (nth 5 eingabe))
(setq startpunkt (list (car startpunkt-xy) (cadr startpunkt-xy) z-start))
(vfs-standard-dialog-berechnen-einfuegen vf-nummer deltaL deltaH richtung startpunkt hz seite nil)
)
)
)
;; ============================================================
;; VARIOFOERDERER_EDIT - Doppelklick/Kontextmenue-Bearbeitung
;; ============================================================
;; Bearbeitet einen bestehenden Standard-VarioFoerderer (VF_n-Block, mit
;; SSG_VF_EDIT-XDATA) ueber die DCL-Dialoge: liest die aktuellen Parameter,
;; zeigt sie vorbelegt und baut die Strecke bei OK am selben Startpunkt neu
;; auf. Wird vom Doppelklick-Dispatcher SSG_BLOCKEDIT fuer Blocknamen "VF_*"
;; aufgerufen. Bloecke ohne SSG_VF_EDIT-XDATA (Etage, Linienzug, Altbestand)
;; werden abgewiesen, da ihre Geometrie sich nicht verlustfrei aus dem
;; einfachen Standard-Schema rekonstruieren laesst.
(defun c:VARIOFOERDERER_EDIT ( / ss ent ed bname startpunkt attribs xd
deltaL deltaH richtung z-start hz seite
eingabe vf-nummer best-winkel-attr L_GF_m-teile
prefill-basis prefill-winkel)
;; Implied Selection VOR ssg-start pruefen (ssg-start hebt Selektion auf)
(setq ss (ssget "I"))
(if (and ss (= (sslength ss) 1)
(= (cdr (assoc 0 (entget (ssname ss 0)))) "INSERT"))
(setq ent (ssname ss 0))
)
(ssg-start "VARIOFOERDERER_EDIT" '(("OSMODE") ("ATTREQ") ("ATTDIA")))
(setvar "OSMODE" 0)
(if (null ent)
(progn
(setq ss (ssget ":S" '((0 . "INSERT"))))
(if ss (setq ent (ssname ss 0)))
)
)
(if (null ent) (progn (ssg-end) (exit)))
(setq ed (entget ent))
(setq bname (cdr (assoc 2 ed)))
(if (not (wcmatch bname "VF_*"))
(progn (alert (ssg-textf "vfs-edit-kein-vf" (list bname))) (ssg-end) (exit)))
(setq xd (vfs-xdata-lesen ent))
(if (or (null xd) (/= (car xd) "standard"))
(progn (alert (ssg-textf "vfs-edit-keine-xdata" (list bname))) (ssg-end) (exit)))
(setq startpunkt (cdr (assoc 10 ed)))
(setq attribs (ssg-attrib-read ent))
(setq hz (atof (nth 1 xd)))
(setq deltaL (atof (cond ((cdr (assoc "DELTA_L_mm" attribs))) ("15000"))))
(setq deltaH (atof (cond ((cdr (assoc "DELTA_H_mm" attribs))) ("3000"))))
(setq richtung (cond ((cdr (assoc "ANTRIEBFAHRTRICHTUNG" attribs))) ("Auf")))
(setq seite (cond ((cdr (assoc "SEITE_AS" attribs))) ("rechts")))
(setq z-start (caddr startpunkt))
(setq prefill-basis
(list (cons "deltaL" deltaL) (cons "deltaH" deltaH) (cons "richtung" richtung)
(cons "einfuegehoehe" z-start) (cons "hz" hz) (cons "seite" seite)))
(setq eingabe (vfs-dialog-eingabe-basis prefill-basis))
(if (null eingabe)
(princ (ssg-text "vfc-vorgang-abgebrochen"))
(progn
(setq deltaL (nth 0 eingabe)
deltaH (nth 1 eingabe)
richtung (nth 2 eingabe)
z-start (nth 3 eingabe)
hz (nth 4 eingabe)
seite (nth 5 eingabe))
(setq startpunkt (list (car startpunkt) (cadr startpunkt) z-start))
;; Vorbelegung Winkel/Verteilung: bestehenden Winkel vorschlagen, L_GF-
;; Verteilung als "Eigene Werte" mit dem aktuellen L_GF1 (aus L_GF_m) -
;; das ist unabhaengig vom urspruenglichen Verteilungsmodus immer exakt.
(setq best-winkel-attr (atoi (cond ((cdr (assoc "VF_WINKEL" attribs))) ("0"))))
(setq L_GF_m-teile (ssg-cfg-split-comma (cond ((cdr (assoc "L_GF_m" attribs))) ("0.0,0.0"))))
(setq prefill-winkel
(list (cons "winkel" best-winkel-attr)
(cons "verteilung-idx" "3")
(cons "lgf1" (* 1000.0 (atof (car L_GF_m-teile))))))
(entdel ent)
(setq vf-nummer (vf-next-number))
(vfs-standard-dialog-berechnen-einfuegen vf-nummer deltaL deltaH richtung
startpunkt hz seite prefill-winkel)
(princ (ssg-textf "vfs-edit-neu-aufgebaut" (list bname)))
)
)
(ssg-end)
(princ)
)
;; ============================================================ ;; ============================================================
;; REGISTRIERUNG ;; REGISTRIERUNG
;; ============================================================ ;; ============================================================
+12
View File
@@ -59,6 +59,9 @@ SSG_LIB
│ │ ├── Antriebst. rechts → OMNI_TEF_AntriebR │ │ ├── Antriebst. rechts → OMNI_TEF_AntriebR
│ │ └── TEF Gerade → OMNI_TEF_Gerade │ │ └── TEF Gerade → OMNI_TEF_Gerade
│ └── KettenFoerderer → OMNI_KettenFoerderer │ └── KettenFoerderer → OMNI_KettenFoerderer
├── Konfiguration
│ ├── Umschalten 2D und 3D → SSG_DIM_SWITCH
│ └── Sprache → SSG_SPRACHE
└── External └── External
├── Call Python → CALLPYTHON ├── Call Python → CALLPYTHON
├── Export Sivas → EXPORTSIVAS ├── Export Sivas → EXPORTSIVAS
@@ -127,6 +130,13 @@ Unterstuetzte Bogenwinkel: 3, 9, 12, 15, 24, 36, 48 Grad
| `SSG-LayerOnAll` | Alle ausgeschalteten Layer einschalten | | `SSG-LayerOnAll` | Alle ausgeschalteten Layer einschalten |
| `SSG-LayerDelete` | Layer und alle Objekte darauf loeschen (mit Bestaetigung) | | `SSG-LayerDelete` | Layer und alle Objekte darauf loeschen (mit Bestaetigung) |
### SSG_LIB_Commands.lsp - Konfiguration
| Befehl | Beschreibung |
| --- | --- |
| `SSG_DIM_SWITCH` | Schaltet zwischen 2D- und 3D-Bloecken um |
| `SSG_SPRACHE` | Sprache umschalten (Deutsch/Englisch), persistiert ueber `DXFM_LANG` |
### tests.lsp - Export und Python-Integration ### tests.lsp - Export und Python-Integration
| Befehl | Beschreibung | | Befehl | Beschreibung |
@@ -140,6 +150,7 @@ Unterstuetzte Bogenwinkel: 3, 9, 12, 15, 24, 36, 48 Grad
| Datei | Beschreibung | | Datei | Beschreibung |
| --- | --- | | --- | --- |
| `ssg_core.lsp` | Kernel: Umgebung, Layer-Ops, Block-Ops, Attribut-Ops, Fehlerbehandlung | | `ssg_core.lsp` | Kernel: Umgebung, Layer-Ops, Block-Ops, Attribut-Ops, Fehlerbehandlung |
| `ssg_lang.lsp` | Sprachumschaltung Deutsch/Englisch (`ssg-text`, `ssg-textf`, `*ssg-lang*`) |
| `ssg_dialog.lsp` | Dialog-Vorlagen: Slide-Preview, Modul-Dialog, Block-Einfuegesequenz | | `ssg_dialog.lsp` | Dialog-Vorlagen: Slide-Preview, Modul-Dialog, Block-Einfuegesequenz |
| `ssg_layer.lsp` | Layer-Verwaltungsbefehle | | `ssg_layer.lsp` | Layer-Verwaltungsbefehle |
| `ssg_load.lsp` | Loader: Laedt alle SSG-Bibliotheken in korrekter Reihenfolge | | `ssg_load.lsp` | Loader: Laedt alle SSG-Bibliotheken in korrekter Reihenfolge |
@@ -180,6 +191,7 @@ dxfmakros/
| `DXFM_CFG` | Konfigurationsdateien | | `DXFM_CFG` | Konfigurationsdateien |
| `DXFM_TESTS` | Testverzeichnis | | `DXFM_TESTS` | Testverzeichnis |
| `DXFM_DATA` | Datenverzeichnis | | `DXFM_DATA` | Datenverzeichnis |
| `DXFM_LANG` | Aktive Sprache (`de_DE`/`en_GB`), persistiert von `SSG_SPRACHE`; Default `de_DE` |
| `BRICSCAD` | Pfad zur BricsCAD-Executable | | `BRICSCAD` | Pfad zur BricsCAD-Executable |
## Einrichtung ## Einrichtung
+3
View File
@@ -15,6 +15,7 @@ REM Pfade fuer verschiedene Komponenten
set "DXFM_BIN=%DXFMAKRO%\bin" set "DXFM_BIN=%DXFMAKRO%\bin"
set "DXFM_LIB=%DXFMAKRO%\lib" set "DXFM_LIB=%DXFMAKRO%\lib"
set "DXFM_DATA=%DXFMAKRO%\data" set "DXFM_DATA=%DXFMAKRO%\data"
set "DXFM_LANG=%DXFMAKRO%\lang"
set "DXFM_TESTS=%DXFMAKRO%\tests" set "DXFM_TESTS=%DXFMAKRO%\tests"
set "DXFM_TESTDATA=%DXFM_TESTS%\testdata" set "DXFM_TESTDATA=%DXFM_TESTS%\testdata"
set "DXFM_TESTOUT=%DXFM_TESTS%\output" set "DXFM_TESTOUT=%DXFM_TESTS%\output"
@@ -60,6 +61,7 @@ if not exist "%DXFM_BIN%" mkdir "%DXFM_BIN%"
if not exist "%DXFM_CFG%" mkdir "%DXFM_CFG%" if not exist "%DXFM_CFG%" mkdir "%DXFM_CFG%"
if not exist "%DXFM_LIB%" mkdir "%DXFM_LIB%" if not exist "%DXFM_LIB%" mkdir "%DXFM_LIB%"
if not exist "%DXFM_DATA%" mkdir "%DXFM_DATA%" if not exist "%DXFM_DATA%" mkdir "%DXFM_DATA%"
if not exist "%DXFM_LANG%" mkdir "%DXFM_LANG%"
if not exist "%DXFM_BLOCKS%" mkdir "%DXFM_BLOCKS%" if not exist "%DXFM_BLOCKS%" mkdir "%DXFM_BLOCKS%"
if not exist "%DXFM_OMNIFLO%" mkdir "%DXFM_OMNIFLO%" if not exist "%DXFM_OMNIFLO%" mkdir "%DXFM_OMNIFLO%"
if not exist "%DXFM_LISP%" mkdir "%DXFM_LISP%" if not exist "%DXFM_LISP%" mkdir "%DXFM_LISP%"
@@ -77,6 +79,7 @@ if /i "%1"=="--persist" (
setx DXFMAKRO "%DXFMAKRO%" >nul setx DXFMAKRO "%DXFMAKRO%" >nul
setx DXFM_LISP "%DXFM_LISP%" >nul setx DXFM_LISP "%DXFM_LISP%" >nul
setx DXFM_DATA "%DXFM_DATA%" >nul setx DXFM_DATA "%DXFM_DATA%" >nul
setx DXFM_LANG "%DXFM_LANG%" >nul
setx DXFM_DCL "%DXFM_DCL%" >nul setx DXFM_DCL "%DXFM_DCL%" >nul
setx DXFM_CFG "%DXFM_CFG%" >nul setx DXFM_CFG "%DXFM_CFG%" >nul
setx DXFM_LOG "%DXFM_LOG%" >nul setx DXFM_LOG "%DXFM_LOG%" >nul
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.

Some files were not shown because too many files have changed in this diff Show More