;; ============================================================
;; 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:
;;   ID        unsichtbar - eindeutige interne Nummer (ID-Raum von SSG_LIB)
;;   FROM_ID   unsichtbar - interne ID der Quelle
;;   TO_ID     unsichtbar - interne ID des Ziels
;;   FROM_TRO  sichtbar   - sprechender Name der Quelle
;;   TO_TRO    sichtbar   - sprechender Name des Ziels
;;   KIND      unsichtbar - flow | colocated
;;
;; 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 "")
)


;; ------------------------------------------------------------
;; Einen TRO-Marker waehlen; liefert (ename interne-ID sprechender-Name)
;; oder nil bei Abbruch bzw. falschem Block.
;; ------------------------------------------------------------
(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)
        (list ent (con-attrib ent "ID") (con-attrib ent "TRO_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 "ID"       neue-id)
          (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 ent "FROM_ID")
        alt-to-id   (con-attrib ent "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 ent "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_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)