;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Beschreibung:  Verschiebt Teile/Baugruppen, die eine Bestimmte Suchvorgabe erfüllen
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package  :custom)
(use-package  :oli)

(sd-defdialog 'Teile_verschieben
  :dialog-title "Teile verschieben"
  :toolbox-button t
  :variables
  '(("Ausgangs - Angaben")
    (objekte
      ;;:value-type  :part-assembly
      :selection (*sd-assembly-seltype* *sd-part-seltype*)
      :title "Teil(e)/Bgr."
      :initial-value nil
      :modifies nil
      :multiple-items t
      :prompt-text "Teil(e)/Baugruppe(n) zum verschieben angeben."
      :show-select-menu t
      :incremental-selection t
    )
    (suchmuster
      :value-type :string
      :proposals '("*DIN*"  "*ISO*"
                  )
      :auto-add-proposal t
      :proposals-order :new-input-at-top
      :title "Suchmuster"
      :prompt-text "Suchmuster incl. Platzhalter * ? [0-9] ... eingeben. (Gross- und Kleinschreibung beachten)"
    )
    ("Ziel - Angaben")
    (zielbaugruppe
      :value-type :assembly
      :title "Ziel-Bgr."
      :initial-value nil
      :prompt-text "Zielbaugruppe angeben."
    )
  ); end variables

  :local-functions
  '((verschieben (item)
      (let (objektname_mit_zaehler stueckzaehler aktuellbaugruppe objektname objektname_mit_zaehler tmpname)
        (progn
          (when (sd-string-match-pattern-p suchmuster (sd-inq-obj-basename item))
            (progn
              (setf objektname_mit_zaehler nil)
              (setf stueckzaehler 0)
              (setf aktuellbaugruppe (sd-inq-parent-obj item))
              (setf objektname (sd-inq-obj-basename item))
              (setf objektname_mit_zaehler (sd-inq-obj-basename item))
              (loop
                ;; Pruefen, ob ein solches Objekt in der Zielbaugruppe vorhanden ist
                (if (sd-pathname-to-obj (format nil "~a/~a" (sd-inq-obj-pathname zielbaugruppe) objektname_mit_zaehler))
                  (progn
                    ;; Wenn bereits vorhanden, dann Stueckzaehler erhoehen und neuen Objektnamen generieren
                    (setf stueckzaehler (+ stueckzaehler 1))
                    (setf objektname_mit_zaehler (format nil "~a.~a" objektname stueckzaehler))
                  )
                  (progn
                    ;; Wenn noch kein Objekt in der Zielbaugruppe vorhanden, dann das Objekt zum verschieben in einen "tmpname" umbenennen
                    (setf tmpname (format nil "tmp__~a" objektname_mit_zaehler))
                    (sd-call-cmds
                      (change_name_pa  :part_asmb item :name tmpname)
                      :failure (sd-display-error (format nil "Fehler beim Umbenennen in den temporaeren Objektnamen: ~s" tmpname))
                    )
                    ;; "tmpname"-Objekt in die Zielbaugruppe verschieben
                    (sd-call-cmds (CHANGE_PA_OWNER :new_owner (sd-inq-obj-pathname zielbaugruppe) :parts_assemblies (format nil "~a/~a" (sd-inq-obj-pathname aktuellbaugruppe) tmpname) )
                      :failure (sd-display-error (format nil "Fehler beim Verschieben von Objekt: ~s in die Zielbaugruppe: ~s" (sd-inq-obj-pathname item) (sd-inq-obj-pathname zielbaugruppe)))
                    )
                    ;; "tmpname"-Objekt in der Zielbaugruppe in den generierten Namen aendern
                    (sd-call-cmds
                      (change_name_pa  :part_asmb (format nil "~a/~a" (sd-inq-obj-pathname zielbaugruppe) tmpname) :name objektname_mit_zaehler)
                      :failure (sd-display-error (format nil "Fehler beim Umbenennen in den generierten Objektnamen: ~a" objektname_mit_zaehler))
                    )
                    (return) ;; Ausstieg
                  ); end progn
                ); end if
              ); end loop
            ); end progn
          ); end when
        ); end progn
      ); end let
    ); end verschieben
  ); end local-funktions
  :ok-action
  '(mapc #'verschieben objekte)
)