;;--------------------------------------------------------------------------*
;;  Copyright 2006  DC4 Technisches Büro GmbH                               *
;;                                                                          *
;;--------------------------------------------------------------------------*

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

;;--------------------------------------------------------------------------*

(sd-defdialog 'dc4-teil-vervielfaeltigen-dialog
:dialog-title "Vervielfaeltigen 2 Punkte"
:variables
  '(
    ;;local
    (back-states :initial-value nil)
    ;;dialog
    (teil  :selection
              (*sd-object-seltype*)
           :multiple-items t
           :show-select-menu t
           :prompt-text "Teil oder Baugruppe angeben"
           :title "Teile"
           ;;:initial-value nil
;;           :next-variable (if (not startp) 'startp 'zielp)
           :next-variable (if (not bgr) 'bgr 'startp)
           :after-input (after-teil-action)
    )
    (bgr   :value-type :assembly
           :prompt-text "Baugruppe angeben"
           :title "Baugruppe"
           :next-variable (if (not teil) 'teil (if (not startp) 'startp 'zielp))
    )
    (startp :value-type :point-3d
           :title "Startpunkt"
           :prompt-text "Startpunkt fuer Vervielfaeltigung angeben"
           :next-variable (if (not teil) 'teil 'zielp)
    )
    (zielp :value-type :point-3d
           :multiple-items t
           :show-select-menu t
           :prompt-text "Zielpunkt angeben"
           :title "Zielpunkt"
           ;;:initial-value nil
           :next-variable (if (not teil) 'teil (if (not startp) 'startp 'zielp))
           :after-input (next-action)
    )
    (back  :title "Zurueck"
           :push-action (back-action)
    )
   )
:local-functions
  '(
    (after-teil-action ()
     (let ()
      (sd-set-variable-status 'bgr :value (sd-inq-parent-obj (first teil)))
     );;let
    )
    (next-action ()
     (let (et)
      (if (and teil bgr startp)
       (progn
        ;; remember current model state:
        (push (sd-set-model-checkpoint) back-states)
        (dolist (et teil)
         (sd-call-cmds (create_multiple_pa :share
;;                       :name (sd-inq-obj-basename teil)
                       :owner (sd-inq-obj-pathname bgr)
                       :source (sd-inq-obj-pathname et)
                       :keep_attr :on
                       :translate :two_ptv  startp zielp
                       :next)
         )
        );;dolist
        (setf zielp nil)
        (when back-states (sd-set-variable-status 'back :enable t))
       );;progn
       (progn
        (sd-display-error "Zielpunkt zuletzt angeben!")
        (setf zielp nil)
       );;progn
      );;if
     );;let
    )
    (back-action ()
     (let ()
      (when back-states
       (progn
        (sd-return-to-model-checkpoint (pop back-states))
        (unless back-states (sd-set-variable-status 'back :enable nil))
       );;progn
      );;when
     );;let
    )
   )
:ok-action
   '()
:help-action '()
)

;;--------------------------------------------------------------------------*