;;--------------------------------------------------------------------------* ;; (c) 2000 DC4 Technisches Büro GmbH * ;;--------------------------------------------------------------------------* ;; Dateiname: dc4_tb_positionieren.lsp ;; Version : 1.0 ;; Datum : 12.12.2000 ;; Author : Gt ;;--------------------------------------------------------------------------* ;; Modulbeschreibung: Teile Positionieren * ;; * ;;--------------------------------------------------------------------------* (in-package :GDM) (use-package :OLI) (use-package :UIB) (use-package :UI) (use-package '(:frame2 :uib)) ;;---------------------------------------------------------------------------------* ;; dialogs * ;;---------------------------------------------------------------------------------* (sd-defdialog 'dc4-tb-positionieren-dialog :dialog-title "Position" :variables '( (partassy :selection (*sd-object-seltype*) :title (sd-multi-lang-string "Part" :german "Teil") :prompt-text (sd-multi-lang-string "Specify Part or Assembly." :german "Teil oder Baugruppe angeben.") );;partassy (positioning :position-part partassy) (uebers1 :title (sd-multi-lang-string "Cone Surface" :german "Kegelflächen")) (kgbew :value-type :face :title (sd-multi-lang-string "move Cone" :german "bew. Kegel") :prompt-text (sd-multi-lang-string "Specify Surface to be moved." :german "Zu bewegende Fläche angeben.") :initial-optional t :check-function #'(lambda (flach) (if (sd-cone-p (sd-inq-geo-props flach)) :ok (values :error (sd-multi-lang-string "Only Cone Surfaces allowed!" :german "Nur Kegelflächen sind erlaubt!")) );;if );;lambda :after-input (kegel-action)) (kgfest :value-type :face :title (sd-multi-lang-string "fixed Cone" :german "fest. Kegel") :prompt-text (sd-multi-lang-string "Specify fixed Surface." :german "Feste Flächen angeben.") :initial-optional t :check-function #'(lambda (flach) (if (sd-cone-p (sd-inq-geo-props flach)) :ok (values :error (sd-multi-lang-string "Only Cone Surfaces allowed!" :german "Nur Kegelflächen erlaubt!")) );;if );;lambda :after-input (kegel-action)) (uebers2 :title (sd-multi-lang-string "Ball - Cone" :german "Kugel - Kegel")) (kugel :value-type :face :title (sd-multi-lang-string "Ball" :german "Kugel") :prompt-text (sd-multi-lang-string "Specify Ball Surface to be moved" :german "Zu bewegende Kugelflaeche angeben") :initial-optional t :check-function #'(lambda (flach) (if (sd-sphere-p (sd-inq-geo-props flach)) :ok (values :error (sd-multi-lang-string "Only Ball Surfaces allowed!" :german "Nur Kugelflächen erlaubt!")))) :after-input (kugel-action)) (kegel :value-type :face :title (sd-multi-lang-string "fixed Cone" :german "fest. Kegel") :prompt-text (sd-multi-lang-string "Specify fixed Surface" :german "Feste Fläche angeben") :initial-optional t :check-function #'(lambda (flach) (if (sd-cone-p (sd-inq-geo-props flach)) :ok (values :error (sd-multi-lang-string "Only Cone Surfaces allowed!" :german "Nur Kegelflächen erlaubt!")))) :after-input (kugel-action)) (kugelrot :push-action (kugelrot-action) :title (sd-multi-lang-string "reverse" :german "umkehren") :initial-enable nil) );;variables :local-functions '( (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-action (kugel-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 );;kugel-action (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 );;kugelrot-action );;local-functions :cancel-action '() :ok-action '() );;sd-defdialog ;;--------------------------------------------------------------------------* ;; 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 );;defun ;;-------------------------------------------------------------------------*/ ;; 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 );;defun