;;--------------------------------------------------------------------------*
;;  Copyright 2014  IWG                                                     *
;;                                                                          *
;;--------------------------------------------------------------------------*

;;--------------------------------------------------------------------------*
;;     in-packages                                                          *
;;--------------------------------------------------------------------------*

(in-package :custom)

;;--------------------------------------------------------------------------*
;;     use-packages                                                         *
;;--------------------------------------------------------------------------*

(use-package :OLI)

;;--------------------------------------------------------------------------*
;;     dialogs                                                              *
;;--------------------------------------------------------------------------*

(sd-defdialog 'iwg-exemplare-zuordnen-dialog
:dialog-title "Exempl. zuordn."
;;:dialog-control :sequential
:variables
  '(
    (quelle :selection (*sd-part-seltype*)
           ;;:multiple-items t
           :show-select-menu t
           :prompt-text "Teil, das als Exemplar verwendet werden soll angeben"
           :title "Quelle"
           :modifies nil
           ;;:initial-value nil
           :after-input (quelle-action)
    )
    (ziel  :selection (*sd-part-seltype*)
           :multiple-items t
           :show-select-menu t
           :prompt-text "Teil oder Teile, die ersetzt werden sollen angeben"
           :title "Ziel"
           ;;:initial-value nil
    )
    (keep-name :value-type :boolean
           :title "Teilename Ïbernehmen"
           :initial-value nil
           :toggle-type :wide-toggle
           :after-input (keep-action)
    )
    (user-name :value-type :boolean
           :title "Teilename definieren"
           :initial-value nil
           :toggle-type :wide-toggle
           :after-input (user-action)
    )
    (name   :value-type :string
            :prompt-text "Neuen Basisnamen angeben"
            :title "Basisname"
            :initial-value nil
            :initial-enable nil
            :initial-optional t
    )
   )
:local-functions
  '(
    (quelle-action ()
     (if keep-name (setf name (sd-inq-obj-basename quelle)))
    )
    (keep-action ()
     (if keep-name
      (progn
       (setf user-name nil)
       (sd-set-variable-status 'name :enable nil)
       (sd-set-variable-status 'name :optional t)
       (if quelle (setf name (sd-inq-obj-basename quelle)))
      );;progn
     );;if
    )
    (user-action ()
     (if user-name
      (progn
       (setf keep-name nil)
       (sd-set-variable-status 'name :enable t)
       (sd-set-variable-status 'name :optional nil)
      );;progn
      (progn
       (sd-set-variable-status 'name :enable nil)
       (sd-set-variable-status 'name :optional t)
      );;progn
     );;if
    )
    (next-action ()
     (if (and quelle ziel)
      (progn
       (sd-call-cmds (iwg-ordne-exemplare-zu quelle ziel keep-name user-name name))
     );;progn
      (sd-display-error "Kein Teile ausgewaehlt")
     );;if
    )
   )
:ok-action
   '(sd-call-cmds (iwg-ordne-exemplare-zu quelle ziel keep-name user-name name))
:help-action '()
)


;;--------------------------------------------------------------------------*
;;     functions                                                            *
;;--------------------------------------------------------------------------*

;;--------------------------------------------------------------------------*
;;     Funktion: iwg-ordne-exemplare-zu                                     *
;;               Ersetzt alle Teile einer Liste                             *
;;               durch Exemplare des ausgewaehlten Teils                    *
;;                                                                          *
;;     Parameter :                                                          *
;;                 quelle ... {SEL_ITEM} des Teils                          *
;;                 ziel ... {List of {SEL_ITEM}}                            *
;;                 keep-name ... {BOOLEAN}                                  *
;;                 user-name ... {BOOLEAN}                                  *
;;                 name ... {String}                                        *
;;                                                                          *
;;     Returnwert: keiner                                                   *
;;-------------------------------------------------------------------------*/

(defun iwg-ordne-exemplare-zu (quelle ziel keep-name user-name name)
 (let (akt_teil tnam teil ex exlist sellist)
  (setf akt_teil (sd-inq-curr-part))
  (cond
   (keep-name (setf tnam (sd-inq-obj-basename quelle)))
   (user-name (setf tnam name))
   (t (setf tnam nil))
  );;cond
  (create_multiple_pa :share :source quelle :name "IWG_Dummy" :owner (sd-pathname-to-obj "/") :keep_attr :on)
  (setf mutter (sd-inq-curr-part))
  (display "Folgende Teile wurden ersetzt:")
  (dolist (teil ziel)
   (when (and (not (equal (sd-inq-obj-sysid quelle) (sd-inq-obj-sysid teil))) (sd-inq-part-p teil))
    (progn
     (setf exlist (sd-inq-obj-shared-objects teil))
     (dolist (ex exlist)
      (if (sd-inq-part-p ex)
       (progn
        (iwg-substitute-part mutter ex tnam)
       );;progn
      );;if
     );dolist
    );;progn
   );;when
  );;dolist
  (delete_3d "/IWG_Dummy")
  (if akt_teil
   (progn
    (setf sellist (sd-call-cmds (get_selection :focus_type *sd-part-seltype* :select :recursive :all_at_top)))
    (if (member akt_teil sellist :test #'equal)
     (current_part (sd-inq-obj-pathname akt_teil))
     )
   );;progn
   nil
  );;if
 );;let
)

;;--------------------------------------------------------------------------*
;;     Funktion: iwg-substitute-part                                        *
;;               Ersetzt einen Teil durch ein Exemplar                      *
;;               eines aehnlichen Teils anhand ihrer                        *
;;               lokalen Koordinatensysteme                                 *
;;                                                                          *
;;     Parameter :                                                          *
;;                 teilneu ... {SEL_ITEM} des Mutterteils                   *
;;                 teilalt ... {SEL_ITEM} des zu ersetzenden Teils          *
;;                 name ... {String}                                        *
;;                                                                          *
;;     Returnwert: keiner                                                   *
;;-------------------------------------------------------------------------*/

(defun iwg-substitute-part (teilneu teilalt name)
 (let (akt_teil lorn lzn lyn lxn lora lza lya lxa bgr tnam pfadalt pfadneu)
  (when (not (equal (sd-inq-obj-sysid teilneu) (sd-inq-obj-sysid teilalt)))
   (progn
    (setf akt_teil (sd-inq-curr-part))
    (setf lorn (sd-vec-xform (make-gpnt3d :x 0 :y 0 :z 0) :source-space teilneu :dest-space :global))
    (setf lzn (sd-vec-xform (make-gpnt3d :x 0 :y 0 :z 1) :source-space teilneu :dest-space :global))
    (setf lyn (sd-vec-xform (make-gpnt3d :x 0 :y 1 :z 0) :source-space teilneu :dest-space :global))
    (setf lxn (sd-vec-xform (make-gpnt3d :x 1 :y 0 :z 0) :source-space teilneu :dest-space :global))
    (setf lora (sd-vec-xform (make-gpnt3d :x 0 :y 0 :z 0) :source-space teilalt :dest-space :global))
    (setf lza (sd-vec-xform (make-gpnt3d :x 0 :y 0 :z 1) :source-space teilalt :dest-space :global))
    (setf lya (sd-vec-xform (make-gpnt3d :x 0 :y 1 :z 0) :source-space teilalt :dest-space :global))
    (setf lxa (sd-vec-xform (make-gpnt3d :x 1 :y 0 :z 0) :source-space teilalt :dest-space :global))
    (setf bgr (sd-inq-parent-obj teilalt))
    (if name
     (progn
      (setf tnam (iwg-gen-part-basename bgr (format nil "~a." name)))
      (create_multiple_pa :share :name tnam :source teilneu :owner bgr :keep_attr :on :match_three_pts lorn lora lxn lxa lyn lya)
     );;progn
     (create_multiple_pa :share :source teilneu :owner bgr :keep_attr :on :match_three_pts lorn lora lxn lxa lyn lya)
    );;if
    (setf pfadalt (sd-inq-obj-pathname teilalt))
    (setf pfadneu (sd-inq-obj-pathname (sd-inq-curr-part)))
    (delete_3d pfadalt)
    (display (format nil "~a durch ~a" pfadalt pfadneu))
   );;progn
  );;when
 );;let
)

;;--------------------------------------------------------------------------*
;;     Funktion: iwg-gen-part-basename                                      *
;;               Erzeugt einen eindeutigen Teilenamen                       *
;;               aus Basisname + Index                                      *
;;                                                                          *
;;     Parameter :                                                          *
;;                 owner ... {SEL_ITEM} der Baugruppe                       *
;;                 teil_bgr ... {SEL_ITEM} des umzubenennenden Teils        *
;;                 prefix ... {STRING} Basisname                            *
;;                                                                          *
;;     Returnwert: keiner                                                   *
;;-------------------------------------------------------------------------*/

(defun iwg-gen-part-basename (owner teil_bgr prefix)
 (let (baslist chlist ch teiletyp bas index name)
  (setf baslist (list))
;;(display owner)
  (setf chlist (sd-inq-obj-children owner))
  (dolist (ch chlist)
   (when (or (sd-inq-part-p ch) (sd-inq-assembly-p ch) (sd-inq-container-p ch))
    (progn
     (when (not (equal ch teil_bgr))
      (progn
       (setf bas (sd-inq-obj-basename ch))
       (setf baslist (nconc baslist (list bas)))
      );;progn
     );;when
    );;progn
   );;when
  );;dolist
  (setf index 0)
;;(display baslist)
  (loop
   (setf index (+ index 1))
   (if (= index 1)
    (setf name prefix)
    (setf name (format nil "~a.~a" prefix index))
   );;if
   (if (not (member name baslist :test #'equal)) (return t))
  );;loop
  (values name)
 );;let
)