;;--------------------------------------------------------------------------*
;; (c) 2000 DC4 Technisches Büro GmbH                                       *
;;--------------------------------------------------------------------------*
;;  Dateiname: kegelpos.lsp
;;  Version  : 2.0
;;  Datum    : 03.05.2004
;;  Author   : Gt
;;--------------------------------------------------------------------------*
;;  Modulbeschreibung: Teile Positionieren                                  *
;;                                                                          *
;;--------------------------------------------------------------------------*

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

(in-package :custom)

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

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

(sd-defdialog 'dc4-positionieren-dialog
  :dialog-title "Kegel Positionieren"
  :variables
  '(
    (partassy  :selection
              (*sd-object-seltype*)
           :show-select-menu t
           :prompt-text "Teil oder Baugruppe angeben"
           :title "Teil"
    )
    (positioning :position-part partassy
    )
    ("Kegelflaechen")
    (kgbew :value-type :face
           :prompt-text "Zu bewegende Flaeche angeben"
           :title "bew. Kegel"
           :initial-optional t
           :check-function
            #'(lambda (flach)
               (if (sd-cone-p (sd-inq-geo-props flach))
                :ok
                (values :error "Nur Kegelflaechen erlaubt!")))
           :after-input (kegel-kegel-action)
    )
    (kgfest :value-type :face
           :prompt-text "Feste Flaeche angeben"
           :title "fest. Kegel"
           :initial-optional t
           :check-function
            #'(lambda (flach)
               (if (sd-cone-p (sd-inq-geo-props flach))
                :ok
                (values :error "Nur Kegelflaechen erlaubt!")))
           :after-input (kegel-kegel-action)
    )
    ("Kegel-Kante")
    (kgbew2 :value-type :face
           :prompt-text "Zu bewegende Flaeche angeben"
           :title "Kegel"
           :initial-optional t
           :check-function
            #'(lambda (flach)
               (if (sd-cone-p (sd-inq-geo-props flach))
                :ok
                (values :error "Nur Kegelflaechen erlaubt!")))
           :after-input (kegel-kante-action)
    )
    (kant  :selection (*sd-circle-3d-seltype* *sd-arc-3d-seltype*)
           :title "Kante"
           :prompt-text "KreisfÎrmige Kante angeben."
           :initial-optional t
           :multiple-items nil
            :check-function
             #'(lambda (kant)
                 (if (or
                      (sd-call-cmds
                                (get_selection :focus_type *sd-cylinder-seltype*
                                               :select :by_edge_3d kant))
                      (sd-call-cmds
                                (get_selection :focus_type *sd-cone-seltype*
                                               :select :by_edge_3d kant))
                     );;or
                  :ok
                  (values :error "Keine angrenzende Bohrung gefunden!")))
           :after-input (kegel-kante-action)
    )
    (umk   :push-action (kegel-umk-action)
           :title "umkehren"
           :initial-enable nil
    )
    ("Kugel-Kegel")
    (kugel :value-type :face
           :prompt-text "Zu bewegende Kugelflaeche angeben"
           :title "Kugel"
           :initial-optional t
           :check-function
            #'(lambda (flach)
               (if (sd-sphere-p (sd-inq-geo-props flach))
                :ok
                (values :error "Nur Kugelflaechen erlaubt!")))
           :after-input (kugel-kegel-action)
    )
    (kegel :value-type :face
           :prompt-text "Feste Flaeche angeben"
           :title "fest. Kegel"
           :initial-optional t
           :check-function
            #'(lambda (flach)
               (if (sd-cone-p (sd-inq-geo-props flach))
                :ok
                (values :error "Nur Kegelflaechen erlaubt!")))
           :after-input (kugel-kegel-action)
    )
    (kugelrot  :push-action (kugelrot-action)
          :title "umkehren"
          :initial-enable nil
    )
   )
  :local-functions
  '(
    (kegel-kegel-action ()
     (let (blist flist p1b p2b p3b p1f p2f p3f)
      (sd-set-variable-status 'kgbew :optional nil)
      (sd-set-variable-status 'kgfest :optional nil)
      (when (and  kgbew kgfest)
       (progn
        (setf blist (dc4-teilpos-get-cone-dir kgbew))
        (setf flist (dc4-teilpos-get-cone-dir kgfest))
        (setf p1b (first blist))
        (setf p2b (second blist))
        (setf p3b (third blist))
        (setf p1f (first flist))
        (setf p2f (second flist))
        (setf p3f (third flist))
        (sd-call-cmds (position_pa (sd-inq-obj-pathname partassy) :match_pt_dir_pt p1b p1f p2b p2f p3b p3f))
        (sd-set-variable-status 'kgbew :optional t)
        (sd-set-variable-status 'kgfest :optional t)
        (setf kgbew nil)
        (setf kgfest nil)
       );;progn
      );;when
     );;let
    )
    (kegel-kante-action ()
     (let (blist flist p1b p2b p3b p1f p2f p3f rad ang)
      (sd-set-variable-status 'kgbew2 :optional nil)
      (sd-set-variable-status 'kant :optional nil)
      (sd-set-variable-status 'umk :enable t)
      (when (and  kgbew2 kant)
       (progn
        (setf blist (dc4-teilpos-get-cone-dir kgbew2))
        (setf flist (dc4-teilpos-get-axis-dir kant))
        (setf p1b (first blist))
        (setf p2b (second blist))
        (setf p3b (third blist))
        (setf p1f (first flist))
        (setf p2f (second flist))
        (setf p3f (third flist))
        (setf rad (sd-circle-radius  (sd-inq-geo-props kant :dest-space :global)))
        (setf ang (sd-cone-angle (sd-inq-geo-props kgbew2 :dest-space :global)))
        (setf p1f (sd-vec-subtract p1f (sd-vec-scale p2f (/ rad (tan ang)))))
        (sd-call-cmds (position_pa (sd-inq-obj-pathname partassy) :match_pt_dir_pt p1b p1f p2b p2f p3b p3f))
        (sd-set-variable-status 'kgbew2 :optional t)
        (sd-set-variable-status 'kant :optional t)
       );;progn
      );;when
     );;let
    )
    (kegel-umk-action ()
     (let (flist p1f p2f p3f)
      (when kant
       (progn
        (setf flist (dc4-teilpos-get-axis-dir kant))
        (setf p1f (first flist))
        (setf p2f (second flist))
        (setf p3f (third flist))
        (sd-call-cmds (position_pa (sd-inq-obj-pathname partassy) :rotate :axis :two_pta p1f p3f :rotation_angle pi))
       );;progn
      );;when
     );;let
    )
    (kugel-kegel-action ()
     (let (blist flist p1b p2b p3b p1f p2f p3f rad ang)
      (sd-set-variable-status 'kugelrot :enable t)
      (sd-set-variable-status 'kugel :optional nil)
      (sd-set-variable-status 'kegel :optional nil)
      (when (and  kugel kegel)
       (progn
        (setf blist (dc4-teilpos-get-sphere-dir kugel))
        (setf flist (dc4-teilpos-get-cone-dir kegel))
        (setf p1b (first blist))
        (setf p2b (second blist))
        (setf p3b (third blist))
        (setf p1f (first flist))
        (setf p2f (second flist))
        (setf p3f (third flist))
        (setf rad (sd-sphere-radius (sd-inq-geo-props kugel :dest-space :global)))
        (setf ang (sd-cone-angle (sd-inq-geo-props kegel :dest-space :global)))
        (setf p1f (sd-vec-add p1f (sd-vec-scale p2f (/ rad (sin ang)))))
        (sd-call-cmds (position_pa (sd-inq-obj-pathname partassy) :match_pt_dir_pt p1b p1f p2b p2f p3b p3f))
        (sd-set-variable-status 'kugel :optional t)
        (sd-set-variable-status 'kegel :optional t)
       );;progn
      );;when
     );;let
    )
    (kugelrot-action ()
     (let (blist flist p1b p2b p3b p1f p2f p3f rad ang)
      (when kugel
       (progn
        (setf blist (dc4-teilpos-get-sphere-dir kugel))
        (setf flist blist)
        (setf p1b (first blist))
        (setf p2b (second blist))
        (setf p3b (third blist))
        (setf p1f (first flist))
        (setf p2f (second flist))
        (setf p3f (third flist))
        (setf p2f (sd-vec-scale p2f -1))
        (sd-call-cmds (position_pa (sd-inq-obj-pathname partassy) :match_pt_dir_pt p1b p1f p2b p2f p3b p3f))
        (sd-set-variable-status 'kugel :optional t)
        (sd-set-variable-status 'kegel :optional t)
        (setf kkugel nil)
        (setf kkegel nil)
       );;progn
      );;when
     );;let
    )
   )
  :cancel-action
       '()
  :ok-action
       '()

)

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

;;-------------------------------------------------------------------------*/
;;     Funktion: dc4-teilpos-get-cone-dir                                   *
;;                                                                          *
;;               Aus Konusflaeche die anschliessende Kreiskante             *
;;               finden und seine Richtung bestimmen                        *
;;               Drei Richtungspunkte zurueckgeben, so dass                 *
;;              1) Punkt 1 auf dem Scheitelpunkt liegt                      *
;;                 und Punkt 2 auf der Achse                                *
;;                                                                          *
;;               2.1)  Falls die Konusachse mit einer der globalen          *
;;                     Achsen gleich ist, so wird liegt der                 *
;;                    dritte auf einer weiteren Achse                       *
;;                                                                          *
;;               2.2)  Falls 2.1) nicht erfolgreich ist , so wird das       *
;;                       gleiche nun mit dem lokalen Koordinatensystem      *
;;                       des Zielteils versucht                             *
;;                                                                          *
;;               2.3)  Falls 2.2) nicht erfolgreich ist , so liegt der      *
;;                     dritte Punkt auf der lokalen X-Achse                 *
;;                                                                          *
;;     Parameter :                                                          *
;;                 keg ... Konusfläche                                      *
;;                          (SEL_ITEM)                                      *
;;                                                                          *
;;     Returnwert:     Liste mit drei Punkten                               *
;;                     nil ... sonst                                        *
;;                                                                          *
;;                                                                          *
;;  Geppert 04.09.2000                                                      *
;;-------------------------------------------------------------------------*/
(defun dc4-teilpos-get-cone-dir (keg)
 (let (p1 axis_dir p2 lx ly lz nlx lly nlz p3)

  (setf p1 (sd-cone-apex (sd-inq-geo-props keg :dest-space :global)))
  (setf axis_dir (sd-cone-axis-dir (sd-inq-geo-props keg :dest-space :global)))
  (setf p2 axis_dir)
  (setf lx (sd-vec-xform (make-gpnt3d :x 1 :y 0 :z 0) :source-space (sd-inq-parent-obj keg) :dest-space :global))
  (setf ly (sd-vec-xform (make-gpnt3d :x 0 :y 1 :z 0) :source-space (sd-inq-parent-obj keg) :dest-space :global))
  (setf lz (sd-vec-xform (make-gpnt3d :x 0 :y 0 :z 1) :source-space (sd-inq-parent-obj keg) :dest-space :global))
  (setf nlx (sd-vec-xform (make-gpnt3d :x -1 :y 0 :z 0) :source-space (sd-inq-parent-obj keg) :dest-space :global))
  (setf nly (sd-vec-xform (make-gpnt3d :x 0 :y -1 :z 0) :source-space (sd-inq-parent-obj keg) :dest-space :global))
  (setf nlz (sd-vec-xform (make-gpnt3d :x 0 :y 0 :z -1) :source-space (sd-inq-parent-obj keg) :dest-space :global))
  (cond
   ((sd-vec-null-p (sd-vec-subtract axis_dir (make-gpnt3d :x 1 :y 0 :z 0))) (setf p3 (sd-vec-add p1 (make-gpnt3d :x 0 :y 1 :z 0))))
   ((sd-vec-null-p (sd-vec-subtract axis_dir (make-gpnt3d :x -1 :y 0 :z 0))) (setf p3 (sd-vec-add p1 (make-gpnt3d :x 0 :y -1 :z 0))))
   ((sd-vec-null-p (sd-vec-subtract axis_dir (make-gpnt3d :x 0 :y 1 :z 0))) (setf p3 (sd-vec-add p1 (make-gpnt3d :x 1 :y 0 :z 0))))
   ((sd-vec-null-p (sd-vec-subtract axis_dir (make-gpnt3d :x 0 :y -1 :z 0))) (setf p3 (sd-vec-add p1 (make-gpnt3d :x -1 :y 0 :z 0))))
   ((sd-vec-null-p (sd-vec-subtract axis_dir (make-gpnt3d :x 0 :y 0 :z 1))) (setf p3 (sd-vec-add p1 (make-gpnt3d :x 1 :y 0 :z 0))))
   ((sd-vec-null-p (sd-vec-subtract axis_dir (make-gpnt3d :x 0 :y 0 :z -1))) (setf p3 (sd-vec-add p1 (make-gpnt3d :x -1 :y 0 :z 0))))
   ((sd-vec-null-p (sd-vec-subtract axis_dir lx)) (setf p3 (sd-vec-add p1 ly)))
   ((sd-vec-null-p (sd-vec-subtract axis_dir ly)) (setf p3 (sd-vec-add p1 lx)))
   ((sd-vec-null-p (sd-vec-subtract axis_dir lz)) (setf p3 (sd-vec-add p1 lx)))
   ((sd-vec-null-p (sd-vec-subtract axis_dir nlx)) (setf p3 (sd-vec-add p1 nly)))
   ((sd-vec-null-p (sd-vec-subtract axis_dir nly)) (setf p3 (sd-vec-add p1 nlx)))
   ((sd-vec-null-p (sd-vec-subtract axis_dir nlz)) (setf p3 (sd-vec-add p1 nlx)))
   (t (progn
       (setf p3 (sd-vec-add p1 (make-gpnt3d :x 1 :y 0 :z 0)))
       (when (sd-vec-null-p (sd-vec-cross-product p3 p2))
          (setf p3 (sd-vec-add p1 (make-gpnt3d :x 0 :y 1 :z 0)))
       );;when
      );;progn
   );;true
  );;cond
  (values (list p1 p2 p3))
 );;let
)

;;-------------------------------------------------------------------------*/
;;     Funktion: dc4-teilpos-get-sphere-dir                                 *
;;                                                                          *
;;               Aus Kugelflaeche Mittelpunkt und Achse                     *
;;               finden und ihre Richtung bestimmen                         *
;;               Drei Richtungspunkte zurueckgeben, so dass                 *
;;              1) Punkt 1 auf dem Mittelpunkt liegt                        *
;;                 und Punkt 2 auf der Achse                                *
;;                                                                          *
;;               2.1)  Falls die Kugelachse mit einer der globalen          *
;;                     Achsen gleich ist, so wird liegt der                 *
;;                    dritte auf einer weiteren Achse                       *
;;                                                                          *
;;               2.2)  Falls 2.1) nicht erfolgreich ist , so wird das       *
;;                       gleiche nun mit dem lokalen Koordinatensystem      *
;;                       des Zielteils versucht                             *
;;                                                                          *
;;               2.3)  Falls 2.2) nicht erfolgreich ist , so liegt der      *
;;                     dritte Punkt auf der lokalen X-Achse                 *
;;                                                                          *
;;     Parameter :                                                          *
;;                 kug ... Kugelfläche                                      *
;;                          (SEL_ITEM)                                      *
;;                                                                          *
;;     Returnwert:     Liste mit drei Punkten                               *
;;                     nil ... sonst                                        *
;;                                                                          *
;;                                                                          *
;;  Geppert 12.12.2000                                                      *
;;-------------------------------------------------------------------------*/
(defun dc4-teilpos-get-sphere-dir (kug)
 (let (p1 axis_dir p2 lx ly lz nlx lly nlz p3)

  (setf p1 (sd-sphere-center (sd-inq-geo-props kug :dest-space :global)))
  (setf axis_dir (sd-sphere-axis-dir (sd-inq-geo-props kug :dest-space :global)))
  (setf p2 axis_dir)
  (setf lx (sd-vec-xform (make-gpnt3d :x 1 :y 0 :z 0) :source-space (sd-inq-parent-obj kug) :dest-space :global))
  (setf ly (sd-vec-xform (make-gpnt3d :x 0 :y 1 :z 0) :source-space (sd-inq-parent-obj kug) :dest-space :global))
  (setf lz (sd-vec-xform (make-gpnt3d :x 0 :y 0 :z 1) :source-space (sd-inq-parent-obj kug) :dest-space :global))
  (setf nlx (sd-vec-xform (make-gpnt3d :x -1 :y 0 :z 0) :source-space (sd-inq-parent-obj kug) :dest-space :global))
  (setf nly (sd-vec-xform (make-gpnt3d :x 0 :y -1 :z 0) :source-space (sd-inq-parent-obj kug) :dest-space :global))
  (setf nlz (sd-vec-xform (make-gpnt3d :x 0 :y 0 :z -1) :source-space (sd-inq-parent-obj kug) :dest-space :global))
  (cond
   ((sd-vec-null-p (sd-vec-subtract axis_dir (make-gpnt3d :x 1 :y 0 :z 0))) (setf p3 (sd-vec-add p1 (make-gpnt3d :x 0 :y 1 :z 0))))
   ((sd-vec-null-p (sd-vec-subtract axis_dir (make-gpnt3d :x -1 :y 0 :z 0))) (setf p3 (sd-vec-add p1 (make-gpnt3d :x 0 :y -1 :z 0))))
   ((sd-vec-null-p (sd-vec-subtract axis_dir (make-gpnt3d :x 0 :y 1 :z 0))) (setf p3 (sd-vec-add p1 (make-gpnt3d :x 1 :y 0 :z 0))))
   ((sd-vec-null-p (sd-vec-subtract axis_dir (make-gpnt3d :x 0 :y -1 :z 0))) (setf p3 (sd-vec-add p1 (make-gpnt3d :x -1 :y 0 :z 0))))
   ((sd-vec-null-p (sd-vec-subtract axis_dir (make-gpnt3d :x 0 :y 0 :z 1))) (setf p3 (sd-vec-add p1 (make-gpnt3d :x 1 :y 0 :z 0))))
   ((sd-vec-null-p (sd-vec-subtract axis_dir (make-gpnt3d :x 0 :y 0 :z -1))) (setf p3 (sd-vec-add p1 (make-gpnt3d :x -1 :y 0 :z 0))))
   ((sd-vec-null-p (sd-vec-subtract axis_dir lx)) (setf p3 (sd-vec-add p1 ly)))
   ((sd-vec-null-p (sd-vec-subtract axis_dir ly)) (setf p3 (sd-vec-add p1 lx)))
   ((sd-vec-null-p (sd-vec-subtract axis_dir lz)) (setf p3 (sd-vec-add p1 lx)))
   ((sd-vec-null-p (sd-vec-subtract axis_dir nlx)) (setf p3 (sd-vec-add p1 nly)))
   ((sd-vec-null-p (sd-vec-subtract axis_dir nly)) (setf p3 (sd-vec-add p1 nlx)))
   ((sd-vec-null-p (sd-vec-subtract axis_dir nlz)) (setf p3 (sd-vec-add p1 nlx)))
   (t (progn
       (setf p3 (sd-vec-add p1 (make-gpnt3d :x 1 :y 0 :z 0)))
       (when (sd-vec-null-p (sd-vec-cross-product p3 p2))
          (setf p3 (sd-vec-add p1 (make-gpnt3d :x 0 :y 1 :z 0)))
       );;when
      );;progn
   );;true
  );;cond
  (values (list p1 p2 p3))
 );;let
)

;;-------------------------------------------------------------------------*/
;;     Funktion: dc4-teilpos-get-axis-dir                                   *
;;                                                                          *
;;               Aus Kreiskante den anschliessenden Zylinder oder Kegel     *
;;               finden und seine Richtung bestimmen                        *
;;               Drei Richtungspunkte zurueckgeben, so dass                 *
;;                                                                          *
;;              1) Punkt 1 in der Mitte der Kante,                          *
;;              2) Punkt 2 auf der Achse und                                *
;;              3) Punkt 3 auf der Kante liegt                              *
;;                                                                          *
;;     Parameter :                                                          *
;;                 ka ... kreisfoermige Kante (3D-Bogen od. 3D-Kreis)       *
;;                          (SEL_ITEM)                                      *
;;                                                                          *
;;     Returnwert:     Liste mit drei Punkten                               *
;;                                                                          *
;;  Geppert 03.05.2004                                                      *
;;-------------------------------------------------------------------------*/
(defun dc4-teilpos-get-axis-dir (ka)
 (let (geo_p p1 sp rad lx ly lz nlx lly nlz cylliste fl axis_dir aussen coneliste planeliste p2 p3)

  (setf geo_p (sd-inq-geo-props ka :dest-space :global))
  (setf p1 (sd-circle-center geo_p))
  (setf sp (sd-circle-start-dir geo_p))
  (setf rad (sd-circle-radius geo_p))

  ;; Selektieren einer Zylinderflaeche
  (setf cylliste (sd-call-cmds
                  (get_selection :focus_type *sd-cylinder-seltype*
                                 :select :by_edge_3d ka)))
  (when cylliste
   (progn
    (setf fl (first cylliste))
    (setf geo_p (sd-inq-geo-props fl :dest-space :global))
    (setf axis_dir (sd-cylinder-axis-dir geo_p))
    (setf aussen nil)
   );;progn
  );;when
  (setf coneliste (sd-call-cmds
                    (get_selection :focus_type *sd-cone-seltype*
                                   :select :by_edge_3d ka)))
  (when coneliste
   (progn
    (setf fl (first coneliste))
    (setf geo_p (sd-inq-geo-props fl :dest-space :global))
    (setf axis_dir (sd-cone-axis-dir geo_p))
    (setf aussen nil)
   );;progn
  );;when
  (setf planeliste (sd-call-cmds
                    (get_selection :focus_type *sd-plane-seltype*
                                   :select :by_edge_3d ka)))
  (when planeliste
   (progn
    (setf fl (first planeliste))
    (setf geo_p (sd-inq-geo-props fl :dest-space :global))
    (setf aussen (sd-plane-normal geo_p))
   );;progn
  );;when
  (when aussen
   (when (sd-vec-null-p (sd-vec-subtract aussen axis_dir))
    (setf axis_dir (sd-vec-scale axis_dir -1))
   );;when
  );;when
  (setf p2 (sd-vec-scale axis_dir -1))
  (setf p3 (sd-vec-add p1 sp))
  (when (sd-vec-null-p (sd-vec-cross-product p3 p2))
   (setf p3 (sd-vec-add p1 (make-gpnt3d :x 1 :y 0 :z 0)))
   (when (sd-vec-null-p (sd-vec-cross-product p3 p2))
    (setf p3 (sd-vec-add p1 (make-gpnt3d :x 0 :y 1 :z 0)))
   );;when
  );;when
  (values (list p1 p2 p3))
 );;let
)