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

(in-package :custom)

(use-package :OLI)

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

(sd-defdialog 'dc4-schnittkraft-ermitteln-dialog
:dialog-title "Schnittkraft"
:variables
  '(
    (ae    :value-type :wp
           :prompt-text "Arbeitsebene angeben"
           :title "Arbeitsebene"
           :modifies :nil
    )
    (flist :selection
              (*sd-face-seltype*)
           :multiple-items t
           :show-select-menu t
           :prompt-text "Schnittflaechen angeben"
           :title "Schnittflaechen"
           ;;:initial-value nil
    )
    (tau   :value-type :positive-number
           :prompt-text "Scherspannung in N/mm2 eingeben"
           :title "Tau [N/mm2]"
           :initial-value nil
    )
    (draw  :value-type :boolean
           :toggle-type :wide-toggle
           :title "SP zeichnen"
           :initial-value t
    )
    (kraft :value-type  :display-only
           :title "Kraft [kN]"
    )
    (ukoor :value-type  :display-only
           :title "U-Koordinate"
    )
    (vkoor :value-type  :display-only
           :title "V-Koordinate"
    )
    (calc  :push-action (schnittkraft-ermitteln)
           :title "berechnen"
           :toggle-type :wide-toggle
    )
   )
:local-functions
  '((schnittkraft-ermitteln ()
     (let ( umomges vmomges flch flinh flsp flkraft umom vmom usp vsp)
      (setf kraft 0)
      (setf umomges 0)
      (setf vmomges 0)
      (dolist (flch flist)
       (setf flinh (sd-call-cmds (get_vol_prop :for_face :face flch :select_done :tol :rough_tol :area)))
       (setf flsp (sd-vec-xform (sd-call-cmds (get_vol_prop :for_face :face flch :select_done :tol :rough_tol :centroid)) :source-space :global :dest-space ae))
       (setf flkraft (* flinh tau))
       (setf umom (* flkraft (gpnt3d_x flsp)))
       (setf vmom (* flkraft (gpnt3d_y flsp)))
       (setf kraft (+ kraft flkraft))
       (setf umomges (+ umomges umom))
       (setf vmomges (+ vmomges vmom))
      );;dolist
      (setf ukoor (/ umomges kraft))
      (setf vkoor (/ vmomges kraft))
      (setf kraft (/ kraft 1000))
      (when draw
       (progn
        (setf sp (make-gpnt2d :x ukoor :y vkoor))
        (sd-call-cmds (c_point sp))
       );;progn
      );;when
     );;let
    )
   )
:ok-action
   '()
)