;;--------------------------------------------------------------------------*
;;  Copyright 2003  DC4 Technisches Büro GmbH                               *
;;                                                                          *
;;--------------------------------------------------------------------------*
;;  Dateiname: bilanz.lsp
;;  Version  : 1.0
;;  Datum    : 20.102003
;;  Author   : Gt
;;--------------------------------------------------------------------------*

(in-package :custom)

(use-package :OLI)

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

(sd-defdialog 'dc4-teile-bilanz-dialog
:dialog-title "Teile zaehlen"
;;:dialog-control :sequential
:variables
  '(
    (bgr   :value-type :assembly
           :prompt-text "Baugruppe angeben"
           :title "Baugruppe"
           :initial-value nil
           :after-input (after-bgr-action)
           :modifies nil
    )
    (ubgr  :value-type :display-only
           :title "Unterbaugr."
    )
    (total :value-type :display-only
           :title "Teile"
    )
    ("davon")
    (vteil :value-type :display-only
           :title "Volumenteile"
    )
    (fteil :value-type :display-only
           :title "Flaechenteile"
    )
    (dteil :value-type :display-only
           :title "Drahtteile"
    )
    (cntteil :value-type :display-only
           :title "Containerteile"
    )
    (lay   :value-type :display-only
           :title "AnsSaetze"
    )
   )
:local-functions
  '((after-bgr-action ()
     (let (vdteil vfteil)
      (setf ubgr (length (sd-call-cmds (get_selection :focus_type *sd-assembly-seltype* :select :recursive :in_assembly bgr))))
      (setf total (length (sd-call-cmds (get_selection :focus_type *sd-part-seltype* :allow_wire_part :allow_face_part :select :recursive :in_assembly bgr))))
      (setf vteil (length (sd-call-cmds (get_selection :focus_type *sd-part-seltype* :allow_wire_part :allow_face_part
                                                      :check_function
                                                       #'(lambda (si)
                                                          (let ()
                                                           (if (or (sd-inq-face-part-p si)  (sd-inq-wire-part-p si))
                                                             :filter
                                                             :ok
                                                           );;if
                                                          );;let
                                                        );;lambda
                                                      :select :recursive :in_assembly bgr))))
      (setf vdteil (length (sd-call-cmds (get_selection :focus_type *sd-part-seltype* :allow_wire_part :allow_face_part
                                                      :check_function
                                                       #'(lambda (si)
                                                          (let ()
                                                           (if (sd-inq-face-part-p si)
                                                             :filter
                                                             :ok
                                                           );;if
                                                          );;let
                                                        );;lambda
                                                      :select :recursive :in_assembly bgr))))
      (setf vfteil (length (sd-call-cmds (get_selection :focus_type *sd-part-seltype* :allow_wire_part :allow_face_part
                                                      :check_function
                                                       #'(lambda (si)
                                                          (let ()
                                                           (if (sd-inq-wire-part-p si)
                                                             :filter
                                                             :ok
                                                           );;if
                                                          );;let
                                                        );;lambda
                                                      :select :recursive :in_assembly bgr))))
      (setf vcntteil (length (sd-call-cmds (get_selection :focus_type *sd-assembly-seltype* :allow_wire_part :allow_face_part
                                                      :check_function
                                                       #'(lambda (si)
                                                          (let ()
                                                           (if (sd-inq-container-p si)
                                                             :filter
                                                             :ok
                                                           );;if
                                                          );;let
                                                        );;lambda
                                                      :select :recursive :in_assembly bgr))))
      (setf lay (length (sd-call-cmds (get_selection :focus_type *sd-layout-seltype* :select :recursive :in_assembly bgr))))
      (setf dteil (- vdteil vteil))
      (setf fteil (- vfteil vteil))
      (setf cntteil (- ubgr vcntteil))
     );;let
    )
   )
:ok-action
   '()
)