;;--------------------------------------------------------------------------*
;;  Copyright 2004  DC4 Technisches Büro GmbH                               *
;;                                                                          *
;;--------------------------------------------------------------------------*
;;  Dateiname: umfang.lsp
;;  Version  : 1.0
;;  Datum    : 07.09.2004
;;  Author   : Gt
;;--------------------------------------------------------------------------*

(in-package :custom)

(use-package :OLI)

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

(sd-defdialog 'dc4-flaechen-umfang-berechnen-dialog-x
:dialog-title "Flaechenumfang"
:dialog-type :interrupt
;;:dialog-control :sequential
:variables
  '(
    (flachl :selection (*sd-face-seltype*)
            :multiple-items t
            :show-select-menu t
            :prompt-text "Flaechen, deren Umfang berechnet werden soll angeben"
            :title "Flaechen"
            :initial-value nil
           :after-input (go-action)
    )
    (umf    :value-type  :display-only
            :title "Umfang"
            :initial-value 0
    )
    (ueb    :push-action (ueb-action)
            :toggle-type :wide-toggle
            :title "Uebernehmen"
    )
   )
:local-functions
  '(
    (go-action ()
     (let (umflist inlist flach ktlist kt ktlang)
      (setf umf 0)
      (setf umflist (list))
      (setf inlist (list))
      (dolist (flach flachl)
       (setf kantlist (dc4-get-flach-ktliste-sel-item flach))
       (dolist (kt kantlist)
        (if  (member kt umflist :test #'equal)
         (progn
          (setf inlist (nconc inlist (list kt)))
          (setf umflist (remove kt umflist  :test #'equal))
         );;progn
         (when (not (member kt inlist :test #'equal))
          (setf umflist (nconc umflist (list kt)))
         );;when
        );;if
       );;dolist
      );;dolist
      (dolist (kt umflist)
       (setf ktlang (sd-call-cmds (measure_dist :edge_length kt)))
       (setf umf (+ umf ktlang))
      );;dolist
     );;let
    )
    (ueb-action ()
     (sd-put-buffer (format nil "\"~4,3,,,'0F\"" umf))
     cancel
    )
   )
:ok-action
   '()
)

(defun dc4-get-flach-ktliste-sel-item ( flach )
 (let (kt)
   (setf kt (sd-call-cmds
                              (get_selection
                               :focus_type *sd-edge-3d-seltype*
                               :select :by_face flach)))
   kt ;; returnwert
  )
)