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

(sd-defdialog 'sd-schraubendruckfeder
  :dialog-title "Schraubendruckfeder"
  :toolbox-button t
  :variables
  '(("Einbau")
    (bgr       :value-type :assembly
               :size :third
               :prompt-text "Baugruppe angeben."
               :title "Baugr.:"
               :next-variable 'firma
    )
    ("Kaufteilbezeichnung")
    (firma     :size :third
               :title "Firma:"
               :prompt-text "Firma eingeben."
               :range (("Steinel" :label "Steinel")
                       ("Danly"   :label "Danly")
                       ("Fibro"   :label "Fibro")
                      )
               :initial-value "Steinel"
               :after-input
               (progn
                 (when (equal firma "Steinel")
                   (setf bez "SZ_80~~.~~x~~~")
                 )
                 (when (equal firma "Danly")
                   (setf bez "9-~~~~-~~~")
                 )
                 (when (equal firma "Fibro")
                   (setf bez "241.1~.~~.~~~")
                 )
               )
               :next-variable 'bez
    )
    (bez       :value-type :string
               :size :third
               :title "Best.-Nr.:"
               :prompt-text "Bestellnummer eingeben."
               :initial-value "SZ_80~~.~~x~~~"
               :after-input
               (progn
                 ;; Pruefen, ob bereits eine solche Schraubendruckfeder in der aktuellen Baugruppe existiert
                 (if (equal (sd-inq-obj-pathname bgr) "/")
                   (setf pruefobjekt (format nil "~aSchraubendruckfeder__~a__~a" (sd-inq-obj-pathname bgr) firma bez))
                   (setf pruefobjekt (format nil "~a/Schraubendruckfeder__~a__~a" (sd-inq-obj-pathname bgr) firma bez))
                 )
                 (when (sd-pathname-to-obj pruefobjekt)
                   (sd-display-message "Es existiert bereits eine solche Schraubendruckfeder in der aktuellen Baugruppe !" :title "Schraubendruckfeder")
                   (setf bgr nil)
                   (setf bez nil)
                 )
               )
    )
    ("Abmessungen")
    (da        :value-type :positive-number
               :title "HÏlsen - Ö:"
               :prompt-text "HÏlsen-Durchmesser eingeben in [mm]."
               :initial-value nil
               :after-input
               (berechne-kraft)
    )
    (di        :value-type :positive-number
               :title "Bolzen - Ö:"
               :prompt-text "Bolzen-Durchmesser eingeben in [mm]."
               :initial-value nil
               :after-input
               (berechne-kraft)
    )
    (lmax      :value-type :positive-number
               :title "Unb. LÌnge:"
               :prompt-text "Unbelastete LÌnge eingeben in [mm]."
               :initial-value nil
               :after-input
               (berechne-kraft)
    )
    (frate     :value-type :positive-number
               :title "R in (N/mm2):"
               :prompt-text "Federrate eingeben in [N/mm]."
               :initial-value nil
               :after-input
               (berechne-kraft)
    )
    (el        :value-type :positive-number
               :title "EinbaulÌnge:"
               :prompt-text "EinbaulÌnge eingeben in [mm]."
               :initial-value nil
               :after-input
               (berechne-kraft)
    )
    (smax      :value-type :positive-number
               :title "Max. Weg:"
               :prompt-text "Maximalen Federweg eingeben in [mm]."
               :initial-value nil
               :after-input
               (berechne-kraft)
    )
    (kraft     :value-type :display-only
               :title "Vorspannkraft:"
               :initial-value nil
    )
    ("-")
    ("Positionierung")
    (punkt     :value-type :point-3d
               :title "Startpunkt:"
               :prompt-text "Startpunkt angeben."
               :before-input
               (check-eingaben)
    )
    (richtung  :value-type :measure-direction
               :prompt-text "Richtung angeben."
               :title "Richtung:"
    )
    (beschr    :value-type :boolean
               :toggle-type :wide-toggle
               :initial-value t
               :title "3D-Beschrift. (Kraft in N)"
    )

   )
  :local-functions
  '((berechne-kraft ()
      (let ()
        (when (and lmax frate el smax)
          (progn
            (setf kraft (* frate (- lmax el)))
            (setf kraft (format nil "~0,3,,,'0F N" kraft))
          )
        )
      )
    )
    (check-eingaben ()
      (let ()
        (if (and bez firma di da lmax frate el smax)
          (progn
            (when (= di da)
              (sd-display-error (format nil "Feder kann nicht erstellt werden ! ~%--> Bolzen-Ö ist ident mit Bohr-Ö !"))
            )
            (when (> di da)
              (sd-display-error (format nil "Feder kann nicht erstellt werden ! ~%--> Bolzen-Ö ist gÎßer als der Bohr-Ö !"))
            )
            (when (> el lmax)
              (sd-display-error (format nil "Feder kann nicht erstellt werden ! ~%--> EinbaulÌnge ist grÎßer als die unbelastete LÌnge !"))
            )
            (when (> smax lmax)
              (sd-display-error (format nil "Feder kann nicht erstellt werden ! ~%--> Max. Weg ist grÎßer als die unbelastete LÌnge !"))
            )
            (when (> smax el)
              (sd-display-error (format nil "Feder kann nicht erstellt werden ! ~%--> Max. Weg ist grÎßer als die EinbaulÌnge !"))
            )
          )
          (sd-display-error "Zum Erstellen einer Schraubendruckfeder wurden noch nicht alle erforderlichen Eingaben gemacht.")
        )
      )
    )
   )
  :ok-action
  '(sd-call-cmds (schraubendruckfeder-erstellen bgr bez firma punkt richtung di da lmax el smax kraft beschr))
  :help-action
  '()
)

(defun schraubendruckfeder-erstellen (wz_bgr wz_bez wz_firma wz_punkt wz_richtung wz_di wz_da wz_lmax wz_el wz_smax wz_kraft wz_beschr)
  (let (akt_a akt_t qb qh bl wdg gh er p1 p2 p3 p4 p5 p6 Teilename Modellname)
    (setf akt_a (sd-inq-curr-wp))                      ;; aktuelle Arbeitsebene
    (setf akt_t (sd-inq-curr-part))                    ;; aktuelles Teil
    (setf qb (/ (- wz_da wz_di) 2))                    ;; Querschnittsbreite vom Nennmass
    (setf qh (/ qb 2))                                 ;; Querschnittshoehe (= Faktor von Querschnittsbreite) vom Nennmass
    (setf bl (- wz_lmax wz_smax))                      ;; Blocklaenge
    (setf wdg (/ (- (+ bl (* qh 1.5)) qh) qh))         ;; Windungsanzahl fuer Spirale
    (setf gh (/ (+ (* qh 0.5) wz_el) wdg))             ;; Ganghoehe fuer Spirale
    (setf er (/ qh 10))                                               ;; Eckenradius (= Faktor von Querschnittshoehe)
    (setf p1 (make-gpnt2d :x (/ (+ wz_di 1) 2) :y (-(* 0.75 qh ))))   ;; Querschnitts-Punkt unten innen
    (setf p2 (make-gpnt2d :x (/ (- wz_da 1) 2) :y (-(* 0.75 qh ))))   ;; Querschnitts-Punkt unten aussen
    (setf p3 (make-gpnt2d :x (/ (+ wz_di 1) 2) :y (* 0.25 qh)))       ;; Querschnitts-Punkt oben innen
    (setf p4 (make-gpnt2d :x (/ (- wz_da 1) 2) :y (* 0.25 qh)))       ;; Querschnitts-Punkt oben aussen
    (setf p5 (make-gpnt2d :x (-(/ wz_da 2))    :y 0))                 ;; Praegepunkt unten links
    (setf p6 (make-gpnt2d :x (/ wz_da 2)       :y wz_el))             ;; Praegepunkt unten links

    (setf Teilename (format nil "Schraubendruckfeder__~a__~a" wz_firma wz_bez))
    (setf Modellname (format nil "~a__~a__EL-~amm" wz_firma wz_bez wz_el))

    (CREATE_PART :NAME Teilename :OWNER (sd-inq-obj-pathname wz_bgr))

    (setf Teilename (format nil "~a~a" (sd-inq-obj-pathname wz_bgr) Teilename))
    (CHANGE_PA_ID (sd-inq-obj-pathname (sd-inq-curr-part)) Modellname)
    (CREATE_WORKPLANE :NEW :NAME "AE_Schraubendruckfeder" :OWNER "/" :PT_DIR :ORIGIN wz_punkt :NORMAL (car wz_richtung) :DONE)
    (POSITION_WP "/AE_Schraubendruckfeder" :ROTATE :AXIS :U :ROTATION_ANGLE (/ (* pi 90) 180))
    (GEOMETRY_MODE :REAL)

    (sd-call-cmds (RECTANGLE p1 p4))
    (sd-call-cmds (FILLET :CREATE :FILLET_RADIUS er p1 p2 p3 p4))
    (sd-call-cmds (HELIX_ADD :AXIS :V :PITCH gh :TURNS wdg :RIGHT :ON :CHECK :OFF))
    (sd-call-cmds (DELETE_2D :CURRENT_WP :EDGE_2D :ALL_2D))
    (sd-call-cmds (RECTANGLE p5 p6))
    (sd-call-cmds (STAMP :KEEP_WP :NO))

    (when (and wz_beschr wz_kraft)
      (COCREATE_3D_NOTE :ACTION :CREATE :NOTE wz_kraft :items (sd-inq-curr-part))
    )

    (set_part_base_density :parts (sd-inq-curr-part) :dens 0.00785)

    (OBJFLAGS (oli::sd-inq-curr-part) :Q_CONTENTS :Q_DBRO :ON :Q_DBMOD :ON)

    (when akt_a
      (progn
        (sd-call-cmds (CURRENT_WP (sd-inq-obj-pathname akt_a)))
      )
    )

  )
)