Merge gemacht. Versuch eines Tests der lisp Routinen erstellt

Lisp/KreiselInsert.lsp

@@ -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)