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

Merge gemacht. Versuch eines Tests der lisp Routinen erstellt

Browse Source
This commit is contained in:
Michael Stangl
2026-05-20 16:31:51 +02:00
parent c2c31898e8
commit 4eb5fc92fc
27 changed files with 3948 additions and 4659 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/KreiselInsert.lsp
+198 -2
View File
@@ -35,7 +35,8 @@
;; Attribut-Definitionen: ((TAG DEFAULT) ...)
(setq *kreisel-attrib-defs*
'(("DREHRICHTUNG" "UZS")
'(("NAME" "")
("DREHRICHTUNG" "UZS")
("N_SEPARATOREN" "2")
("KREISELART" "STANDARD")
("N_SCANNER" "0")
@@ -233,6 +234,8 @@
(assoc "ABSTAND" attribs) attribs))
(setq attribs (subst (cons "DREHUNG" (rtos rotation 2 1))
(assoc "DREHUNG" attribs) attribs))
(setq attribs (subst (cons "HOEHE" (rtos (if (caddr basePoint) (caddr basePoint) 0.0) 2 1))
(assoc "HOEHE" attribs) attribs))
(setq is-pin (equal (cdr (assoc "KREISELART" attribs)) "PIN"))
;; AUTOMATISCHE NUMMER VERGEBEN
@@ -736,6 +739,199 @@
)
;; ============================================================
;; TEIL 5: KREISEL BEARBEITEN (DCL-Dialog)
;; ============================================================
;; Ausrichtungs-Definitionen: ((Label Rotation) ...)
;; Rotation in Grad: 0=rechts, 90=oben, 180=links, 270=unten
(setq *kreisel-ausrichtungen*
'(("Horizontal MS" 0.0)
("Horizontal SM" 180.0)
("Vertikal MS" 90.0)
("Vertikal SM" 270.0))
)
;; Rotation (Grad) -> Ausrichtungs-Index (fuer popup_list)
(defun kreisel-rotation-to-idx (rot / idx i entry diff)
(setq idx 0 i 0)
(foreach entry *kreisel-ausrichtungen*
(setq diff (abs (- (rem (+ rot 360.0) 360.0)
(rem (+ (cadr entry) 360.0) 360.0))))
(if (< diff 1.0) (setq idx i))
(setq i (1+ i))
)
idx
)
;; Ausrichtungs-Index -> Rotation (Grad)
(defun kreisel-idx-to-rotation (idx)
(cadr (nth idx *kreisel-ausrichtungen*))
)
;; -----------------------------------------------
;; KreiselEdit: Bestehenden Kreisel per Dialog bearbeiten
;;
;; Ablauf:
;; 1. Kreisel-Block auswaehlen (oder vorselektiert)
;; 2. DCL-Dialog mit aktuellen Werten oeffnen
;; 3. Bei OK: Block loeschen und mit neuen Werten neu zeichnen
;; -----------------------------------------------
(defun c:KreiselEdit ( / sel ss ent ed attribs basePoint rotation
dcl-pfad dat ergebnis
dlg-name dlg-abstand dlg-hoehe dlg-ausrichtung
dlg-drehrichtung dlg-kreiselart
newAbstand newRotation ausrichtLabels)
;; 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 "Kreisel bearbeiten" '(("OSMODE") ("CECOLOR") ("ATTREQ") ("ATTDIA")))
(setvar "OSMODE" 0)
;; 1. Block auswaehlen (falls nicht vorselektiert)
(if (null ent)
(progn
(setq sel (entsel "\nKreisel-Block auswaehlen: "))
(if sel (setq ent (car sel)))
)
)
(if (null ent) (progn (ssg-end) (exit)))
(setq ed (entget ent))
(if (/= (cdr (assoc 0 ed)) "INSERT")
(progn (ssg-emsg "Kein Block ausgewaehlt!") (ssg-end) (exit))
)
;; 2. Bestehende Werte auslesen
(setq attribs (ssg-attrib-read ent))
(setq basePoint (cdr (assoc 10 ed)))
(setq rotation (* (/ 180.0 pi) (cdr (assoc 50 ed))))
;; Pruefen ob Block Kreisel-Attribute hat (mindestens ABSTAND)
(if (null (assoc "ABSTAND" attribs))
(progn
(ssg-emsg "Kein Kreisel-Block! (Attribut ABSTAND fehlt)")
(ssg-end)
(exit)
)
)
;; Fehlende Attribute mit Defaults auffuellen
(foreach def *kreisel-attrib-defs*
(if (null (assoc (car def) attribs))
(setq attribs (append attribs (list (cons (car def) (cadr def)))))
)
)
;; HOEHE immer aus Z-Koordinate des Einfuegepunkts befuellen
(setq attribs (subst (cons "HOEHE" (rtos (if (caddr basePoint) (caddr basePoint) 0.0) 2 1))
(assoc "HOEHE" attribs) attribs))
(princ (strcat "\n-> Bestehend: Abstand=" (cdr (assoc "ABSTAND" attribs))
" Drehung=" (rtos rotation 2 1)
" Art=" (cdr (assoc "KREISELART" attribs))))
;; 3. DCL-Dialog laden
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/kreisel_edit.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "kreisel_edit" dat))
(progn (alert (strcat "Dialog nicht verfuegbar: " dcl-pfad)) (ssg-end) (exit))
)
;; Ausrichtungs-Labels fuer popup_list aufbauen
(setq ausrichtLabels "")
(foreach entry *kreisel-ausrichtungen*
(if (= ausrichtLabels "")
(setq ausrichtLabels (car entry))
(setq ausrichtLabels (strcat ausrichtLabels "\n" (car entry)))
)
)
;; Tiles initialisieren
(set_tile "name" (cdr (assoc "NAME" attribs)))
(set_tile "abstand" (cdr (assoc "ABSTAND" attribs)))
(set_tile "hoehe" (cdr (assoc "HOEHE" attribs)))
(start_list "ausrichtung")
(foreach entry *kreisel-ausrichtungen*
(add_list (car entry))
)
(end_list)
(set_tile "ausrichtung" (itoa (kreisel-rotation-to-idx rotation)))
(start_list "drehrichtung")
(add_list "UZS")
(add_list "GUZ")
(end_list)
(set_tile "drehrichtung" (if (equal (cdr (assoc "DREHRICHTUNG" attribs)) "GUZ") "1" "0"))
(start_list "kreiselart")
(add_list "STANDARD")
(add_list "PIN")
(end_list)
(set_tile "kreiselart" (if (equal (cdr (assoc "KREISELART" attribs)) "PIN") "1" "0"))
;; Actions
(action_tile "accept"
(strcat
"(setq dlg-name (get_tile \"name\"))"
"(setq dlg-abstand (get_tile \"abstand\"))"
"(setq dlg-hoehe (get_tile \"hoehe\"))"
"(setq dlg-ausrichtung (get_tile \"ausrichtung\"))"
"(setq dlg-drehrichtung (get_tile \"drehrichtung\"))"
"(setq dlg-kreiselart (get_tile \"kreiselart\"))"
"(done_dialog 1)"
)
)
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
;; 4. Bei OK: Block loeschen und neu zeichnen
(if (= ergebnis 1)
(progn
;; Werte aufbereiten
(setq newAbstand (atof dlg-abstand))
(setq newRotation (kreisel-idx-to-rotation (atoi dlg-ausrichtung)))
;; Attribute aktualisieren
(setq attribs (subst (cons "NAME" dlg-name)
(assoc "NAME" attribs) attribs))
(setq attribs (subst (cons "HOEHE" dlg-hoehe)
(assoc "HOEHE" attribs) attribs))
(setq attribs (subst (cons "KREISELART"
(if (= dlg-kreiselart "1") "PIN" "STANDARD"))
(assoc "KREISELART" attribs) attribs))
(setq attribs (subst (cons "DREHRICHTUNG"
(if (= dlg-drehrichtung "1") "GUZ" "UZS"))
(assoc "DREHRICHTUNG" attribs) attribs))
;; Alten Block loeschen
(command "_.ERASE" ent "")
;; Neu zeichnen mit Z-Koordinate aus Hoehe-Dialogwert
(draw-module (list (car basePoint) (cadr basePoint) (atof dlg-hoehe))
newAbstand newRotation attribs)
(princ (strcat "\nKreisel aktualisiert: "
"Name=" dlg-name
" Abstand=" (rtos newAbstand 2 0)
" Hoehe=" dlg-hoehe
" Rotation=" (rtos newRotation 2 1)))
)
(princ "\nAbgebrochen.")
)
(ssg-end)
)
;; --------------------------------------------
;; KreiselParams: Aktuelle Parameter anzeigen
;; --------------------------------------------
@@ -806,5 +1002,5 @@
)
(princ "\nKreiselInsert.lsp geladen (Version 7.0 - Auto-Nummerierung + Beschriftung + Attribute + Redraw + Eckrad)")
(princ "\nBefehle: KreiselInsert, KreiselConnect, KreiselRedraw, KreiselQuick, KreiselParams, ILS_Eckrad")
(princ "\nBefehle: KreiselInsert, KreiselConnect, KreiselRedraw, KreiselEdit, KreiselQuick, KreiselParams, ILS_Eckrad")
(princ)
Lisp/tests.lsp
+89 -130
View File
@@ -26,75 +26,59 @@
)
;; ============================================================
;; EXPORTCSV - Alle INSERT-Entities sammeln und als JSON exportieren
;; EXPORT - Relevante INSERT-Entities sammeln und als JSON exportieren
;; Anschliessend Python-Skript aufrufen fuer CSV-Erzeugung
;; ============================================================
;; --- Wert sicher als String zurueckgeben ---
(defun csv:to-str (val)
(cond
((null val) "")
((= (type val) 'STR) val)
((= (type val) 'INT) (itoa val))
((= (type val) 'REAL) (rtos val 2 6))
(T (vl-princ-to-string val))
)
)
;; --- String fuer JSON escapen (Anfuehrungszeichen) ---
(defun csv:json-escape (s / pos result ch)
(setq result "")
(setq pos 1)
(repeat (strlen s)
(setq ch (substr s pos 1))
(cond
((= ch "\"") (setq result (strcat result "\\\"")))
((= ch "\\") (setq result (strcat result "\\\\")))
(T (setq result (strcat result ch)))
)
(setq pos (1+ pos))
)
result
;; --- String fuer JSON escapen (Anfuehrungszeichen/Backslash) ---
;; Nutzt vl-string-subst fuer die haeufigsten Faelle statt
;; zeichenweiser Verkettung (deutlich schneller bei langen Strings).
(defun csv:json-escape (s)
(setq s (vl-string-subst "\\\\" "\\" s))
(vl-string-subst "\\\"" "\"" s)
)
;; --- Attribute eines INSERT-Blocks als JSON-Objekt lesen ---
;; ename = Entity-Name des INSERT
;; Rueckgabe: String wie {"TAG1":"Wert1","TAG2":"Wert2"}
(defun csv:read-attribs (ename / obj typ tag wert result first-item)
(defun csv:read-attribs (ename / obj ed typ tag wert parts)
(setq obj (entnext ename))
(setq result "{")
(setq first-item T)
(while (and obj (not (equal (cdr (assoc 0 (entget obj))) "SEQEND")))
(setq typ (cdr (assoc 0 (entget obj))))
(if (equal typ "ATTRIB")
(setq parts nil)
(while obj
(setq ed (entget obj))
(setq typ (cdr (assoc 0 ed)))
(if (equal typ "SEQEND") (setq obj nil)
(progn
(setq tag (cdr (assoc 2 (entget obj))))
(setq wert (cdr (assoc 1 (entget obj))))
(if (not first-item)
(setq result (strcat result ","))
(if (equal typ "ATTRIB")
(setq parts (cons (strcat "\"" (csv:json-escape (cdr (assoc 2 ed)))
"\":\"" (csv:json-escape (cdr (assoc 1 ed))) "\"")
parts))
)
(setq result (strcat result
"\"" (csv:json-escape tag) "\":\""
(csv:json-escape wert) "\""))
(setq first-item nil)
(setq obj (entnext obj))
)
)
(setq obj (entnext obj))
)
(strcat result "}")
(if parts
(progn
(setq parts (reverse parts))
(strcat "{" (car parts)
(apply 'strcat (mapcar '(lambda (p) (strcat "," p)) (cdr parts)))
"}")
)
"{}"
)
)
;; --- Einen INSERT-Block als JSON-Objekt schreiben ---
(defun csv:block-to-json (ename / ed blk-name layer pt rotation handle attribs has-attribs)
(defun csv:block-to-json (ename / ed blk-name layer pt rotation handle attribs)
(setq ed (entget ename))
(setq blk-name (cdr (assoc 2 ed)))
(setq layer (cdr (assoc 8 ed)))
(setq pt (cdr (assoc 10 ed)))
(setq rotation (cdr (assoc 50 ed)))
(setq handle (cdr (assoc 5 ed)))
(setq has-attribs (cdr (assoc 66 ed)))
(if (null rotation) (setq rotation 0.0))
(if has-attribs
(if (cdr (assoc 66 ed))
(setq attribs (csv:read-attribs ename))
(setq attribs "{}")
)
@@ -104,35 +88,71 @@
",\"handle\":\"" (csv:json-escape handle) "\""
",\"x\":" (rtos (car pt) 2 4)
",\"y\":" (rtos (cadr pt) 2 4)
",\"z\":" (rtos (caddr pt) 2 4)
",\"z\":" (rtos (if (caddr pt) (caddr pt) 0.0) 2 4)
",\"rotation\":" (rtos (* (/ rotation pi) 180.0) 2 4)
",\"attribs\":" attribs
"}"
)
)
;; --- EXPORTSIVAS: Sivas-spezifischer CSV-Export mit Summierungszeilen ---
(defun c:EXPORTSIVAS ( / ss i ename json-str out-pfad py-skript cmd fh
ergebnis-pfad first-block count)
(princ "\n[EXPORTSIVAS] Sammle alle Bloecke der Zeichnung...")
;; --- Relevante Bloecke sammeln ---
;; Filtert INSERT-Entities auf exportierbare Bloecke:
;; KR_* = Kreisel Compound-Bloecke
;; AP110* = Omniflo Geraden
;; Omniflo Boegen/Weichen = rein numerische Blocknamen (SivasNr)
;; Vario* = VarioFoerderer-Bloecke
;; Gibt Auswahlsatz zurueck oder nil.
(defun csv:collect-export-blocks ( / ss-all ss-out i ename ed bname)
(setq ss-all (ssget "X" (list (cons 0 "INSERT"))))
(if (null ss-all) (setq ss-out nil)
(progn
(setq ss-out (ssadd))
(setq i 0)
(while (setq ename (ssname ss-all i))
(setq ed (entget ename))
(setq bname (cdr (assoc 2 ed)))
(if (or
(wcmatch bname "KR_*")
(wcmatch (strcase bname) "AP110*,AP_110*")
(wcmatch bname "Vario*,Staustrecke*,AUS_Element*,EIN_Element*")
;; Rein numerische Namen = Omniflo SivasNr (Boegen/Weichen)
(wcmatch bname "#*")
)
(ssadd ename ss-out)
)
(setq i (1+ i))
)
(if (= (sslength ss-out) 0) (setq ss-out nil))
)
)
ss-out
)
;; Alle INSERT-Entities in der Zeichnung
(setq ss (ssget "X" (list (cons 0 "INSERT"))))
;; --- Gemeinsame Export-Funktion ---
;; Sammelt relevante Bloecke, schreibt JSON, ruft Python auf.
;; label = Anzeigename (z.B. "EXPORTCSV")
;; py-name = Python-Skript-Name (z.B. "export_csv.py")
;; csv-name = Ergebnis-CSV-Name (z.B. "export.csv")
(defun csv:run-export (label py-name csv-name / ss i ename fh out-pfad
py-skript ergebnis-pfad cmd first-block count)
(princ (strcat "\n[" label "] Sammle relevante Bloecke..."))
(setq ss (csv:collect-export-blocks))
(if (null ss)
(progn
(princ "\n[EXPORTSIVAS] Keine Bloecke in der Zeichnung gefunden.")
(princ (strcat "\n[" label "] Keine relevanten Bloecke gefunden."))
(princ)
)
(progn
(setq count (sslength ss))
(princ (strcat "\n[EXPORTSIVAS] " (itoa count) " Bloecke gefunden."))
(princ (strcat "\n[" label "] " (itoa count) " Bloecke gefunden."))
;; JSON-Datei zusammenbauen
(setq out-pfad (strcat (getenv "DXFM_RESULTS") "/export_raw.json"))
(setq fh (open out-pfad "w"))
(if (null fh)
(progn
(princ (strcat "\n[EXPORTSIVAS] FEHLER: Kann Datei nicht oeffnen: " out-pfad))
(princ (strcat "\n[" label "] FEHLER: Kann Datei nicht oeffnen: " out-pfad))
(princ)
)
(progn
@@ -143,32 +163,28 @@
(if (not first-block)
(write-line "," fh)
)
(setq json-str (csv:block-to-json ename))
(write-line json-str fh)
(write-line (csv:block-to-json ename) fh)
(setq first-block nil)
(setq i (1+ i))
)
(write-line "]" fh)
(close fh)
(princ (strcat "\n[EXPORTSIVAS] JSON geschrieben: " out-pfad))
(princ (strcat "\n[" label "] JSON geschrieben: " out-pfad))
;; Python-Skript aufrufen
(setq py-skript (strcat (getenv "DXFM_LIB") "/export_sivas.py"))
(setq py-skript (strcat (getenv "DXFM_LIB") "/" py-name))
(if (findfile py-skript)
(progn
(setq ergebnis-pfad (strcat (getenv "DXFM_RESULTS") "/export_sivas.csv"))
(setq ergebnis-pfad (strcat (getenv "DXFM_RESULTS") "/" csv-name))
(setq cmd (strcat "python \"" py-skript "\""
" \"" out-pfad "\""
" \"" (getenv "DXFM_DATA") "\""
" \"" ergebnis-pfad "\""))
(princ (strcat "\n[EXPORTSIVAS] Rufe Python auf..."))
(command "_.SHELL" cmd)
(if (findfile ergebnis-pfad)
(princ (strcat "\n[EXPORTSIVAS] CSV erstellt: " ergebnis-pfad))
(princ "\n[EXPORTSIVAS] WARNUNG: CSV-Datei wurde nicht erzeugt.")
)
(princ (strcat "\n[" label "] Rufe Python auf..."))
(startapp "cmd" (strcat "/c " cmd))
(princ (strcat "\n[" label "] Export gestartet: " ergebnis-pfad))
)
(princ (strcat "\n[EXPORTSIVAS] FEHLER: Python-Skript nicht gefunden: " py-skript))
(princ (strcat "\n[" label "] FEHLER: Python-Skript nicht gefunden: " py-skript))
)
)
)
@@ -177,69 +193,12 @@
(princ)
)
;; --- EXPORTSIVAS: Sivas-spezifischer CSV-Export mit Summierungszeilen ---
(defun c:EXPORTSIVAS ()
(csv:run-export "EXPORTSIVAS" "export_sivas.py" "export_sivas.csv")
)
;; --- EXPORTCSV: Einfache Item-Liste aller Bloecke (ohne Summierung) ---
;; Nutzt dieselben csv:* Hilfsfunktionen und export_raw.json,
;; ruft export_csv.py auf fuer die einfache CSV-Erzeugung.
(defun c:EXPORTCSV ( / ss i ename json-str out-pfad py-skript cmd fh
ergebnis-pfad first-block count)
(princ "\n[EXPORTCSV] Sammle alle Bloecke der Zeichnung...")
(setq ss (ssget "X" (list (cons 0 "INSERT"))))
(if (null ss)
(progn
(princ "\n[EXPORTCSV] Keine Bloecke in der Zeichnung gefunden.")
(princ)
)
(progn
(setq count (sslength ss))
(princ (strcat "\n[EXPORTCSV] " (itoa count) " Bloecke gefunden."))
(setq out-pfad (strcat (getenv "DXFM_RESULTS") "/export_raw.json"))
(setq fh (open out-pfad "w"))
(if (null fh)
(progn
(princ (strcat "\n[EXPORTCSV] FEHLER: Kann Datei nicht oeffnen: " out-pfad))
(princ)
)
(progn
(write-line "[" fh)
(setq i 0)
(setq first-block T)
(while (setq ename (ssname ss i))
(if (not first-block)
(write-line "," fh)
)
(setq json-str (csv:block-to-json ename))
(write-line json-str fh)
(setq first-block nil)
(setq i (1+ i))
)
(write-line "]" fh)
(close fh)
(princ (strcat "\n[EXPORTCSV] JSON geschrieben: " out-pfad))
;; Python-Skript aufrufen
(setq py-skript (strcat (getenv "DXFM_LIB") "/export_csv.py"))
(if (findfile py-skript)
(progn
(setq ergebnis-pfad (strcat (getenv "DXFM_RESULTS") "/export.csv"))
(setq cmd (strcat "python \"" py-skript "\""
" \"" out-pfad "\""
" \"" (getenv "DXFM_DATA") "\""
" \"" ergebnis-pfad "\""))
(princ (strcat "\n[EXPORTCSV] Rufe Python auf..."))
(command "_.SHELL" cmd)
(if (findfile ergebnis-pfad)
(princ (strcat "\n[EXPORTCSV] CSV erstellt: " ergebnis-pfad))
(princ "\n[EXPORTCSV] WARNUNG: CSV-Datei wurde nicht erzeugt.")
)
)
(princ (strcat "\n[EXPORTCSV] FEHLER: Python-Skript nicht gefunden: " py-skript))
)
)
)
)
)
(princ)
(defun c:EXPORTCSV ()
(csv:run-export "EXPORTCSV" "export_csv.py" "export.csv")
)