#|
Autor: Patrick Weber

Changelog:

06.12.2008 16:30   modified push-abst
04.12.2008 10:10   added sd-num-equal-p
03.12.2008 22:40   first release


basierend auf 
achsabstand_wg.lsp
(dc4-achsabstand-berechnen-dialog)
DC4 Technisches Büro GmbH  

ä Ì   Ä Ø    ö Î    Ö Ú    ü Ï    Ü Û    ß Þ    ° ³
|#

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


(sd-defdialog 'cust-meas-axis-plane-dialog
:dialog-title "Abstand Achse-OberflÌche"
:dialog-type :interrupt
:variables
  '(
    (achs
            :selection (*sd-cone-seltype* *sd-torus-seltype* *sd-cylinder-seltype*)
            :multiple-items nil
            :prompt-text "RotationsflÌche angeben"
            :title "Achse"
            :initial-value nil
            :after-input (go-action)
    )
    (flaech
            :selection (*sd-plane-seltype*)
            :multiple-items nil
            :title "OberflÌche"
            :prompt-text "FlÌche waehlen."
            :after-input (go-action)
    )
    (abst   :value-type  :display-only
            :title "Abstand"
            :initial-value 0
    )
    (ausr   :value-type  :display-only
            :title "Achsricht."
            :initial-value nil
    )
    ("Wert Ïbernehmen?")
    (psh
            :title "Ûbernehmen"
            :push-action (push-abst)
    )
    ("-")
    (clear_all
            :title "RÏcksetzen"
            :push-action (setf achs nil flaech nil abst nil ausr nil)
            :next-variable 'achs
    )
  )
:local-functions
  '(
    (go-action ()
     (let (p1 dir1 p2 dir2)
      (when (and achs flaech)
       (progn
        (cond
         ((sd-cylinder-p (sd-inq-geo-props achs))
          (progn
           (setf p1 (sd-cylinder-center (sd-inq-geo-props achs :dest-space :global)))
           (setf dir1 (sd-cylinder-axis-dir (sd-inq-geo-props achs :dest-space :global)))
          );;progn
         );;cylinder
         ((sd-cone-p (sd-inq-geo-props achs))
          (progn
           (setf p1 (sd-cone-apex (sd-inq-geo-props achs :dest-space :global)))
           (setf dir1 (sd-cone-axis-dir (sd-inq-geo-props achs :dest-space :global)))
          );;progn
         );;cone
         ((sd-torus-p (sd-inq-geo-props achs))
          (progn
           (setf p1 (sd-torus-center (sd-inq-geo-props achs :dest-space :global)))
           (setf dir1 (sd-torus-axis-dir (sd-inq-geo-props achs :dest-space :global)))
          );;progn
         );;torus
        );cond
        (setf p2 (sd-plane-origin (sd-inq-geo-props flaech :dest-space :global)))
        (setf dir2 (sd-plane-normal (sd-inq-geo-props flaech :dest-space :global)))
         ; (display (format nil "~a~%~a~%~a~%~a~%~a~%" dir1 dir2 p1 p2 (sd-vec-scalar-product dir1 dir2)))
        (if (sd-num-equal-p 0 (sd-vec-scalar-product dir1 dir2))
        (progn
          (setf abst (abs (sd-call-cmds (measure_dist :between_points p1 p2 :direction dir2))))
          (setf ausr "parallel")
         );;progn
         (progn
          (setf abst 0)
          (setf ausr "windschief")
         );;progn
        );;if
       );;progn
      );;when
     );;let
    )
    (push-abst ()
      (progn
         (sd-put-buffer (format nil "~f" abst))
         (cancel)
      )
    )
  )
:ok-action '()
:help-action '()
)