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

;;----------------------------------------------------------------------------------------------*
;; Vorgaben setzen:                            ;; Moegliche Vorgabewerte:
;;----------------------------------------------------------------------------------------------*
(setf Geometrieerstellung "Hilfsgeometrie")    ;; "Hilfsgeometrie" , "Geometrie"
(setf Ae_einpassen_merker t)                   ;; t oder nil
(setf Geo_ausblenden_merker t)                 ;; t oder nil
(setf Behaelterobjekte_merker t)               ;; t oder nil
;;----------------------------------------------------------------------------------------------*

(sd-defdialog 'baugruppenquerschnitt
  :dialog-title "Baugruppenquerschnitt"
  :toolbox-button t
  :variables
  '(("Arbeitseb. - Auswahl")
    (Arbeitsebene
      :selection (*sd-workplane-seltype*)
      ;;:show-select-menu t
      :multiple-items nil
      :title "Arbeitseb."
      :prompt-text "Arbeitsebene, auf welche die Querschnitt-Projektion erfolgen soll, angeben."
      :initial-value (sd-inq-curr-wp)

    )
    ("Teile/Baugr. - Auswahl")
    (Teile
      ;;:value-type :part
      :selection (*sd-part-seltype*)
      :face-part-allowed nil
      :multiple-items t
      :show-select-menu t
      :incremental-selection t
      :title "Teil(e):"
      :prompt-text "Teil(e) fÏr Querschnitt-Projektion angeben."
      :initial-value nil
    )
    (Baugruppen
      ;;:value-type :part
      :selection (*sd-assembly-seltype*)
      :multiple-items t
      :show-select-menu t
      :incremental-selection t
      :title "Baugr.:"
      :prompt-text "Baugruppe(n) fÏr Querschnitt-Projektion angeben."
      :initial-value nil
    )
    ("Querschnitt erstellen als:")
    (Geometrie
      :value-type :boolean
      :toggle-type :grouped-toggle
      :title "Geometrie"
      :initial-value (if (equal Geometrieerstellung "Geometrie") t nil)
      :after-input
      (progn
        (setf Geometrie t)
        (setf Hilfsgeometrie nil)
        (setf Geometrieerstellung "Geometrie")
      )
    )
    (Hilfsgeometrie
      :value-type :boolean
      :toggle-type :grouped-toggle
      :title "Hilfsgeom."
      :initial-value (if (equal Geometrieerstellung "Hilfsgeometrie") t nil)
      :after-input
      (progn
        (setf Hilfsgeometrie t)
        (setf Geometrie nil)
        (setf Geometrieerstellung "Hilfsgeometrie")
      )
    )
    ("Anzeige - Optionen")
    (Ae_einpassen
      :value-type :boolean
      :toggle-type :wide-toggle
      :title "AE in DF einpassen"
      :initial-value Ae_einpassen_merker
      :after-input
      (if Ae_einpassen
         (setf Ae_einpassen_merker t)
         (setf Ae_einpassen_merker nil)
       )
     )
    (Geo_ausblenden
      :value-type :boolean
      :toggle-type :wide-toggle
      :title "Geometrie ausblenden"
      :initial-value Geo_ausblenden_merker
      :after-input
      (if Geo_ausblenden
         (setf Geo_ausblenden_merker t)
         (setf Geo_ausblenden_merker nil)
       )
     )
    (Behaelterobjekte
      :value-type :boolean
      :toggle-type :wide-toggle
      :title "Ohne BehÌlter-Objekte"
      :initial-value Behaelterobjekte_merker
      :after-input
      (if Behaelterobjekte
         (setf Behaelterobjekte_merker t)
         (setf Behaelterobjekte_merker nil)
       )
     )
   )
   :mutual-exclusion
   '(Teile Baugruppen)
   :local-functions
   '((teilequerschnitt-erstellen (Teileliste)
       (let (Teil)
         (progn
           (when Geometrie
             (GEOMETRY_MODE :REAL)
           )
           (when Hilfsgeometrie
             (GEOMETRY_MODE :CONSTRUCTION)
           )
           (dolist (Teil Teileliste)
             (if Behaelterobjekte
               (progn
                 (when (not (behaelterobjekt-pruefen Teil))
                   (sd-call-cmds
                     (cross_section
                       :cross_section_part (sd-inq-obj-pathname Teil)
                       :cross_section_wp (sd-inq-obj-pathname Arbeitsebene)
                     )
                       :failure (sd-display-error "Fehler bei der Querschnitt-Projektion !")
                   )
                 )
               )
               (progn
                 (sd-call-cmds
                   (cross_section
                     :cross_section_part (sd-inq-obj-pathname Teil)
                     :cross_section_wp (sd-inq-obj-pathname Arbeitsebene)
                   )
                     :failure (sd-display-error "Fehler bei der Querschnitt-Projektion !")
                 )
               )
             )
           )
         )
       )
     )


     (baugruppenquerschnitt-erstellen (Baugruppen)
       (let (Baugruppe)
         (progn
           (dolist (Baugruppe Baugruppen)
             (progn
               (when Geometrie
                 (GEOMETRY_MODE :REAL)
               )
               (when Hilfsgeometrie
                 (GEOMETRY_MODE :CONSTRUCTION)
               )
               (setf Einzelteile nil)
               (setf Einzelteile
                 (sd-call-cmds
                   (get_selection :focus_type (list *sd-part-seltype* *sd-assembly-seltype*)
				             :check_function #'(lambda (pseudo)
                                         (if (equal (sel_item-type pseudo) *sd-part-seltype*)
                                           :ok
                                           :filter
                                         )
                                       )
				             :select :recursive :in_assembly Baugruppe
				           )
                   :failure (sd-display-error "Fehler beim ermitteln der Baugruppen-Einzelteile !")
                 )
               )
               (teilequerschnitt-erstellen Einzelteile)
             )
           )
         )
       )
     )


     (behaelterobjekt-pruefen (object)
       (let (returnwert)
         (progn
           (setf returnwert nil)
           (setf pfad object)
           (loop
             (when (equal (sd-inq-parent-obj pfad) nil)
               (return) ;; Ausstieg wenn im Root angelangt
             )
             (if (sd-inq-container-p pfad)
               (progn
                 (setf returnwert t)
                 (return) ;; Ausstieg wenn ein Behaelter im Pfad gefunden
               )
               (setf pfad (sd-inq-parent-obj pfad))
             )
           )
           returnwert
         )
       )
     )


    )
   :ok-action
   '(progn
      (if Teile
        (teilequerschnitt-erstellen Teile)
        (baugruppenquerschnitt-erstellen Baugruppen)
      )
      (when Ae_einpassen
        (progn
          (uic_view_by_wp_and_fit (oli::sd-inq-curr-wp) :off (oli::sd-inq-current-vp))
          (remove_from_vp_drawlist (oli::sd-inq-current-vp) :workplane :recursive :all_at_top complete update_screen)
          (add_to_vp_drawlist (oli::sd-inq-current-vp) :workplane :current complete update_screen)
          (fit_vp (oli::sd-inq-current-vp) update_screen)
        )
      )
      (when Geo_ausblenden
        (progn
          (uic_set_show_mode :3DGEO :TOGGLE (oli::sd-inq-current-vp) update_screen)
        )
      )
    )
   :cancel-action
   '()
   :cleanup-action
   '()
)