;;--------------------------------------------------------------------------*
;; (c) 2005 DC4 Technisches Büro GmbH                                       *
;;--------------------------------------------------------------------------*
;;  Dateiname: bohrkegel.lsp
;;  Version  : 1.0
;;  Datum    : 04.10.2005
;;  Author   : Gt
;;--------------------------------------------------------------------------*
;;  Modulbeschreibung: Bohrkegel erzeugen                                   *
;;                                                                          *
;;--------------------------------------------------------------------------*

;;--------------------------------------------------------------------------*
;;     in-packages                                                          *
;;--------------------------------------------------------------------------*

(in-package :custom)

;;--------------------------------------------------------------------------*
;;     use-packages                                                         *
;;--------------------------------------------------------------------------*
(use-package :OLI)

;;--------------------------------------------------------------------------*
;;     dialogs                                                              *
;;--------------------------------------------------------------------------*

(sd-defdialog 'dc4-bohrung-kegel-dialog
:dialog-title "Bohrkegel erzeugen"
;;:dialog-control :sequential
:variables
  '(
    ;;lokal
    (back    :initial-value nil)
    (teil)
    (center)
    (normal)
    (start-dir)
    (radius)
    ;;dialog
    (flach   :value-type :face
             :multiple-items nil
             :modifies :contents
             :prompt-text "Kreisfoermige Flaeche fuer Bohrerkegel angeben"
             :title "Kreisflaeche"
             :initial-value nil
             :check-function
              #'(lambda (wert)
                 (let (kreis eig kantlist kant kprop)
                  (setf kreis nil)
                  (setf eig (sd-inq-parent-obj wert))
                  (when (sd-inq-part-p eig)
                   (setf teil eig)
                  );;when
                  (when (sd-plane-p (sd-inq-geo-props wert))
                   (progn
                    (setf kantlist (dc4-get-flach-ktliste-sel-item wert))
                    (when (= 1 (length kantlist))
                     (progn
                      (setf kant (first kantlist))
                      (setf kprop (sd-inq-geo-props kant :dest-space :global))
                      (when (and teil (sd-circle-p kprop))
                       (progn
                        (setf kreis t)
                        (setf normal (sd-plane-normal (sd-inq-geo-props wert :dest-space :global)))
                        (setf center (sd-circle-center kprop))
                        (setf start-dir (sd-circle-start-dir kprop))
                        (setf radius (sd-circle-radius kprop))
                       );;progn
                      );;when
                     );;progn
                    );;when
                   );;progn
                  );;when
                  (if kreis
                   :ok
                   (values :error "Diese Flaeche ist keine Kreisflaeche oder gehoert zu keinem Teil!")
                  );;if
                 );;let
                );;lambda
    )
    (wink    :value-type :positive-number
             :prompt-text "Kegelwinkel fuer Bohrerkegel angeben"
             :title "Winkel"
             :initial-value 120
            :check-function
              #'(lambda (wert)
                  (if (and (< wert 180) (> wert 0))
                   :ok
                   (values :error "Nur Werte groesser als 0 und kleiner als 180 erlaubt!")
                  );;if
                );;lambda
    )
    (next
            :push-action (sd-call-cmds (next-action))
            :next-variable 'flach
    )
   )
:after-initialization
  '()
:local-functions
  '(
    (next-action ()
     (dc4-bohrung-erzeuge-kegel teil center normal radius wink)
     (setf flach nil)
    )
   )
:cancel-action
   '()
:ok-action
   '(sd-call-cmds (dc4-bohrung-erzeuge-kegel teil center normal radius wink))
:cleanup-action
   '()
:help-action '()
)

;;--------------------------------------------------------------------------*
;;     functions                                                            *
;;--------------------------------------------------------------------------*

(defun dc4-bohrung-erzeuge-kegel (teil center normal radius wink)
 (let (bt p1 p2 p3)
  (setf bt (/ radius (tan (/ (* pi wink) 360))))
  (setf p1 (make-gpnt2d :x 0 :y 0))
  (setf p2 (make-gpnt2d :x bt :y 0))
  (setf p3 (make-gpnt2d :x 0 :y radius))
  (setf akt_wp (sd-inq-curr-wp)) ;; aktuelle Arbeitsebene
  (create_workplane :new)
  (GEOMETRY_MODE :REAL)
  (position_wp :current :pt_dir :origin center :normal normal)
  (position_wp :current :rotate :axis :v :rotation_angle (/ (* pi 90) 180))
  (polygon p1 p2 p3 :close) ;;Bohrung zeichnen
  (bore :parts (sd-inq-obj-pathname teil) :axis :u :rotation_angle (/ (* pi 360) 180) :keep_wp :no) ;;Bohrung bohren
  (if akt_wp (current_wp akt_wp) nil)
 );;let
)

(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
  )
)