Schoenenberger_Systeme_GmbH/dxfmakros
7
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
767e47980bdeca2bc7ad3e2ed98c7b40b6d652f7
dxfmakros/Lisp/Connection_Edit.lsp
T
s.ayadi 767e47980b CONNECTION_INSERT/EDIT: Attributnamen wie die Bloecke aus sps_skel 
Die Befehle schrieben ID/FROM_ID/TO_ID und lasen den Markernamen aus TRO_ID -
Attribute, die CONNECTION_ARROW und die TRO-Marker von tro_annotate nicht
haben (ssg-attrib-set-on ueberspringt sie still). Jetzt UID/FROM_UID/TO_UID
und Markername aus ID; alte Namen werden mitgelesen und mitgeschrieben.
Rueckweg nach sps_skel: tro_annotate --read-tros (edit_connections).

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-10-27 14:32:11 +01:00

281 lines
9.9 KiB
Common Lisp
Raw Blame History

;; ============================================================
;; CONNECTION_EDIT.LSP - Verbindungen zwischen TROs
;;
;; Eine Verbindung ist ein Block CONNECTION_ARROW in der Mitte eines Pfeils
;; zwischen zwei TRO-Markern. Sie haelt die Beziehung ueber die *internen* IDs
;; der beiden TROs fest, nicht ueber die Lage im Plan:
;;
;; TRO11 ----------> TRO14
;; ID 0062 ID 0065
;;
;; Attribute des Verbindungsblocks (wie sps_skel lib/tro_annotate.py sie
;; anlegt):
;; UID unsichtbar - eindeutige interne Nummer (ID-Raum von SSG_LIB)
;; FROM_UID unsichtbar - interne Nummer (UID) des Quell-Markers
;; TO_UID unsichtbar - interne Nummer (UID) des Ziel-Markers
;; FROM_TRO unsichtbar - sprechender Name der Quelle (Attribut ID des Markers)
;; TO_TRO unsichtbar - sprechender Name des Ziels
;; KIND unsichtbar - flow | weiche
;; Aeltere Bloecke trugen ID/FROM_ID/TO_ID - gelesen wird beides, geschrieben
;; wird in beide Namen (ssg-attrib-set-on ueberspringt fehlende Attribute).
;;
;; Zurueck nach sps_skel: tro_annotate --read-tros liest die Verbindungsbloecke
;; mit; ein Ende wird erst ueber den Namen (FROM_TRO/TO_TRO), sonst ueber die
;; UID einem Marker zugeordnet. Hinzugefuegte und geloeschte Bloecke werden zu
;; [<csv>.edit_connections] in cfg/tro_overrides.ini. Eine Verbindung loescht
;; man mit ihrem Block (Pfeil-Geometrie allein zaehlt nicht).
;;
;; Warum interne IDs: der sprechende Name darf sich aendern (TRO_EDIT), die
;; interne ID nicht. Ein DXF-Export kann die Beziehung damit eindeutig
;; rekonstruieren, auch wenn Marker verschoben oder umbenannt wurden.
;;
;; Befehle:
;; CONNECTION_INSERT - zwei TRO-Marker waehlen, Verbindung einzeichnen
;; CONNECTION_EDIT - Quelle/Ziel einer bestehenden Verbindung aendern
;;
;; Aufruf:
;; - Doppelklick auf die Verbindung -> ***DOUBLECLICK [INSERT] -> SSG_BLOCKEDIT
;; - EATTEDIT -> c:EATTEDIT -> SSG_BLOCKEDIT
;; - Menue SSG_LIB > Connections
;; Der Dispatcher SSG_BLOCKEDIT leitet Blocknamen "CONNECTION_*" hierher.
;;
;; Setzt ssg_core.lsp (ssg-start/ssg-end, ssg-attrib-*), ssg_lang.lsp und
;; ssg_id.lsp (ssg-id-max, ssg-id-format) voraus.
;; ============================================================
(setq *connection-block* "CONNECTION_ARROW")
;; ------------------------------------------------------------
;; Attribut eines Blocks lesen ("" wenn nicht vorhanden)
;; ------------------------------------------------------------
(defun con-attrib (ent tag / wert)
(setq wert (cdr (assoc tag (ssg-attrib-read ent))))
(if wert wert "")
)
;; Erstes nicht leeres Attribut aus einer Liste von Tags (neu vor alt)
(defun con-attrib-1 (ent tags / wert)
(setq wert "")
(foreach tag tags
(if (= wert "") (setq wert (con-attrib ent tag)))
)
wert
)
;; ------------------------------------------------------------
;; Einen TRO-Marker waehlen; liefert (ename interne-ID sprechender-Name)
;; oder nil bei Abbruch bzw. falschem Block. Marker von sps_skel tragen die
;; interne Nummer in UID und den Namen in ID (aeltere: ID und TRO_ID).
;; ------------------------------------------------------------
(defun con-pick-tro (prompt-key / sel ent bname)
(setq sel (entsel (ssg-text prompt-key)))
(if (null sel)
nil
(progn
(setq ent (car sel)
bname (cdr (assoc 2 (entget ent))))
(if (not (wcmatch bname "TRO_*"))
(progn (alert (ssg-textf "con-kein-tro" (list bname))) nil)
(if (/= (con-attrib ent "UID") "")
(list ent (con-attrib ent "UID") (con-attrib ent "ID"))
(list ent (con-attrib ent "ID") (con-attrib-1 ent '("TRO_ID" "ID"))))
)
)
)
)
;; ------------------------------------------------------------
;; C:CONNECTION_INSERT - Verbindung zwischen zwei TRO-Markern einzeichnen
;;
;; Zeichnet Schaft und Spitze auf den Fluss-Layer und setzt den
;; Verbindungsblock in die Mitte, ausgerichtet entlang des Pfeils.
;; ------------------------------------------------------------
(defun c:CONNECTION_INSERT ( / von nach p1 p2 dx dy laenge winkel mitte
kopf ent-neu neue-id layer-name)
(ssg-start "CONNECTION_INSERT" '(("OSMODE") ("ATTREQ") ("ATTDIA") ("CLAYER")))
(setvar "OSMODE" 0)
(if (not (tblsearch "BLOCK" *connection-block*))
(progn
(alert (ssg-textf "con-block-fehlt" (list *connection-block*)))
(ssg-end)
(exit)
)
)
(setq von (con-pick-tro "con-quelle-waehlen"))
(if (null von) (progn (ssg-end) (exit)))
(setq nach (con-pick-tro "con-ziel-waehlen"))
(if (null nach) (progn (ssg-end) (exit)))
(if (= (car von) (car nach))
(progn (alert (ssg-text "con-gleicher-block")) (ssg-end) (exit))
)
(setq p1 (cdr (assoc 10 (entget (car von))))
p2 (cdr (assoc 10 (entget (car nach)))))
(setq dx (- (car p2) (car p1))
dy (- (cadr p2) (cadr p1))
laenge (distance p1 p2))
(if (<= laenge 1e-6)
(progn (alert (ssg-text "con-gleicher-punkt")) (ssg-end) (exit))
)
(setq winkel (atan dy dx)
mitte (list (/ (+ (car p1) (car p2)) 2.0)
(/ (+ (cadr p1) (cadr p2)) 2.0)
0.0))
;; Layer wie die uebrigen Verbindungen der Beschriftung
(setq layer-name "TRO_FLOW")
(ssg-make-layer layer-name "5" T)
;; Schaft
(entmake (list (cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 8 layer-name)
(cons 100 "AcDbPolyline")
(cons 90 2)
(cons 70 0)
(cons 10 (list (car p1) (cadr p1)))
(cons 10 (list (car p2) (cadr p2)))))
;; Verbindungsblock in die Mitte, entlang des Pfeils gedreht
(setvar "ATTREQ" 0)
(setvar "ATTDIA" 0)
(command "_.-INSERT" *connection-block* mitte "" "" (angtos winkel 0 8))
(setq ent-neu (entlast))
;; Eindeutige interne ID im ID-Raum von SSG_LIB
(setq neue-id (ssg-id-format (1+ (ssg-id-max))))
(ssg-attrib-set-on ent-neu
(list (cons "UID" neue-id)
(cons "ID" neue-id)
(cons "FROM_UID" (cadr von))
(cons "TO_UID" (cadr nach))
(cons "FROM_ID" (cadr von))
(cons "TO_ID" (cadr nach))
(cons "FROM_TRO" (caddr von))
(cons "TO_TRO" (caddr nach))
(cons "KIND" "flow")))
(entupd ent-neu)
(princ (ssg-textf "con-eingefuegt"
(list (caddr von) (caddr nach) neue-id)))
(ssg-end)
(princ)
)
;; ------------------------------------------------------------
;; C:CONNECTION_EDIT - Quelle/Ziel einer Verbindung aendern
;; ------------------------------------------------------------
(defun c:CONNECTION_EDIT ( / ss ent ed bname
alt-from-id alt-to-id alt-from alt-to alt-kind
neu-from-id neu-to-id neu-from neu-to
dcl-pfad dat ergebnis)
;; 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 "CONNECTION_EDIT" nil)
(if (null ent)
(progn
(princ (ssg-text "cmd-block-auswaehlen"))
(setq ss (ssget ":S" '((0 . "INSERT"))))
(if ss (setq ent (ssname ss 0)))
)
)
(if (null ent)
(progn (princ (ssg-text "cmd-kein-block-ausgewaehlt")) (ssg-end) (exit))
)
(setq ed (entget ent)
bname (cdr (assoc 2 ed)))
(if (not (wcmatch bname "CONNECTION_*"))
(progn
(alert (ssg-textf "con-keine-verbindung" (list bname)))
(ssg-end)
(exit)
)
)
(setq alt-from-id (con-attrib-1 ent '("FROM_UID" "FROM_ID"))
alt-to-id (con-attrib-1 ent '("TO_UID" "TO_ID"))
alt-from (con-attrib ent "FROM_TRO")
alt-to (con-attrib ent "TO_TRO")
alt-kind (con-attrib ent "KIND"))
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/connection_edit.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "connection_edit" dat))
(progn
(alert (ssg-textf "con-dialog-fehlt" (list dcl-pfad)))
(ssg-end)
(exit)
)
)
(set_tile "blockname" (ssg-textf "con-block" (list bname (con-attrib-1 ent '("UID" "ID")))))
(set_tile "from_id" alt-from-id)
(set_tile "from_tro" alt-from)
(set_tile "to_id" alt-to-id)
(set_tile "to_tro" alt-to)
(set_tile "richtung" (ssg-textf "con-richtung" (list alt-from alt-to)))
(set_tile "hinweis" (ssg-text "con-hinweis"))
(setq neu-from-id alt-from-id neu-to-id alt-to-id
neu-from alt-from neu-to alt-to)
(action_tile "from_id" "(setq neu-from-id (get_tile \"from_id\"))")
(action_tile "to_id" "(setq neu-to-id (get_tile \"to_id\"))")
(action_tile "from_tro" "(setq neu-from (get_tile \"from_tro\"))")
(action_tile "to_tro" "(setq neu-to (get_tile \"to_tro\"))")
(action_tile "accept"
(strcat "(setq neu-from-id (get_tile \"from_id\")"
" neu-to-id (get_tile \"to_id\")"
" neu-from (get_tile \"from_tro\")"
" neu-to (get_tile \"to_tro\"))"
"(done_dialog 1)"))
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(if (= ergebnis 1)
(if (or (= (vl-string-trim " " neu-from-id) "")
(= (vl-string-trim " " neu-to-id) ""))
(alert (ssg-text "con-id-leer"))
(if (= neu-from-id neu-to-id)
(alert (ssg-text "con-gleiche-id"))
(progn
(ssg-attrib-set-on ent
(list (cons "FROM_UID" neu-from-id)
(cons "TO_UID" neu-to-id)
(cons "FROM_ID" neu-from-id)
(cons "TO_ID" neu-to-id)
(cons "FROM_TRO" neu-from)
(cons "TO_TRO" neu-to)
(cons "KIND" (if (= alt-kind "") "flow" alt-kind))))
(entupd ent)
(princ (ssg-textf "con-gespeichert" (list neu-from neu-to)))
)
)
)
)
(ssg-end)
(princ)
)
(prompt "\nConnection_Edit.lsp geladen - Befehle: CONNECTION_INSERT, CONNECTION_EDIT")
(princ)
Reference in New Issue View Git Blame Copy Permalink