;*********************************************************************************************
; Dateiname 		: 	SD_Move.lsp
; Autor         : 	wz (geklaut von DC4/CAD.DE)
; Erstellt      :		28.01.2008
; geändert    	:
;*********************************************************************************************
; Beschreibung:		- 	Bewegen von Teilen mit Positionierungsfunktionen
;									-	
;*********************************************************************************************
; Änderungen
;
;*********************************************************************************************
(in-package 	:teo) 
(use-package 	:oli)


(sd-defdialog 'SD_Move


:dialog-title "Move NT"
:toolbox-button t
   
:variables '(   

;;================================================================================================
;;=========== zu positionierendes Objekt & Besitzer auswählen ====================================
;;================================================================================================
  
("Teil-/Baugruppenwahl")
          
	(TempBG  
		:value-type :part-assembly
;		:initial-value nil
    :modifies :instance
    :after-input
    	(progn
    		(setf partassy TempBG)
      	(fensterauf)
			);progn
    :title "Teil/Bg."
	);;TempBG
                
	(Besitzer 
		:value-type :assembly
    :modifies :instance
    :initial-optional t
    :initial-value "/"
  );;Besitzer 
          
;;================================================================================================
;;=========== Kreiskante-Kreiskante ==============================================================
;;================================================================================================
     
("Kreiskante-Kreiskante")  
    		 
	(linie1	
		:value-type 	:edge
    :modifies nil    
    :title "Kreisk.beweg."
    :initial-optional T
    :after-input (progn
    								(sd-set-variable-status 'linie2 :optional nil )                   
    								(when (and linie1 linie2)
    									(sd-set-variable-status 'next :enable t)
    								);;if
    							);;progn
  );;linie1 
      
	(linie2	
  	:value-type 	:edge
  	:modifies nil   
  	:initial-optional T
  	:title "Kreisk.fest"
  	:after-input	(progn
        						(when (and linie1 linie2)
    									(sd-set-variable-status 'next :enable t)
    								);;if                		
          					(inlinie)
				 					);;progn
  );;linie2 

	(next 
		:title "umkehren"
		:initial-enable nil
    :push-action 	(progn
                 		(sd-call-cmds 
                 			(position_pa TempBG
                     		:rotate
                     		:axis circen2 cirstart2
                     		:rotation_angle pi
                     		);;position_pa
                    );;sd-call-cmds          
          				);;progn
	);;next
  
;;================================================================================================
;;=========== Kegel-Kegel ========================================================================
;;================================================================================================
   	   	
("Kegel-Kegel")
    
	(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 (sd-multi-lang-string "Conical Surface Only!" :german "Nur Kegelflaechen erlaubt!"))
    	   );;if
    	  );;check-function
    :after-input (kegel-kegel-action);;OK
    :next-variable kgfest 
    );;kgbew
    
	(kgfest 
		:value-type :face
    :prompt-text (sd-multi-lang-string "Pick Countersink" :german "Feste Flaeche angeben")
    :title (sd-multi-lang-string "Countersink" :german "fest. Kegel")
    :initial-optional t
    :check-function
     #'(lambda (flach)
        (if (sd-cone-p (sd-inq-geo-props flach))
         :ok
         (values :error (sd-multi-lang-string "Conical Surface Only!" :german "Nur Kegelflaechen erlaubt!"))))
    :after-input (kegel-kegel-action);;OK
    );;kgfest
 
;;================================================================================================
;;=========== kegel-kante ========================================================================
;;================================================================================================
    	
("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 (sd-multi-lang-string "Conical Surface Only!" :german "Nur Kegelflaechen erlaubt!"))
               );;if
              );;check-function
    :after-input (kegel-kante-action)
    :next-variable kant
    );;kgbew2
    
	(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 (sd-multi-lang-string "No Adjacent Drilling Found!" :german "Keine angrenzende Bohrung gefunden!"))
                 );;if
               );;check-function
		:after-input (kegel-kante-action)
   );;kant  
   
   
	(umk   
		:push-action (kegel-umk-action)
    :title "umkehren"
    :initial-enable nil
  );;umk
   
   
    	

;;================================================================================================
;;=========== kugel-kegel ========================================================================
;;================================================================================================

("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!")
        );;if
      );;check-function
    :after-input (kugel-kegel-action)	;;OK
    :next-variable kegel
	);;kugel
    
	(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!")
               );;if
              );;check-function
           :after-input (kugel-kegel-action) ;;OK
    );;kegel
    
    (kugelrot  
    			:push-action (kugelrot-action) ;;OK
          :title  "umkehren"
          :initial-enable nil
    );;kugelrot



;;================================================================================================
;;=========== freies positionieren ===============================================================
;;================================================================================================
   	             
("freies positionieren")
                 
	(POSITIONING 
	  :title "positionieren"
	  :toogle-type :wide-toogle
		:position-part TempBG 		 
  );;POSITIONING

;;================================================================================================
;;=========== Zusatzfenster ======================================================================
;;================================================================================================

("Fenstertools")

	(fensteropen 
		:push-action 	(progn                     
                  	(fensterauf)
                  );;progn            
	  :title "AUF"
	);;fensteropen   
	             
	(fensteloesch 
		:push-action 	(progn
                  	(fensterzu)  
                  ); Ende progn            
	  :title "ZU"
	);;fensteloesch


       
     
                       
     ) ;end variables
               
	:ok-action
  		'( progn 	(wechslebaugruppe) 
 					(fensterzu)
  		  );end progn

 	:cancel-action
      	'(progn (fensterzu)      
		);end Progn


  	:help-action
    	'(progn
    	(sd-display-url ( Format NIL "~A/SD_Move.htm" (oli::sd-convert-filename-from-platform (oli::sd-sys-getenv "SCHILLERHELPDIR"))))
		); end progn
		

:local-functions
'(


;;================================================================================================
;;=========== kegel-kegel ausrichten =============================================================
;;================================================================================================

    (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-kegel-action

;;================================================================================================
;;=========== kegel-kante ausrichten =============================================================
;;================================================================================================

    (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-kante-action

;;================================================================================================
;;=========== kugel-kegel ========================================================================
;;================================================================================================

    (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
    );;kugel-kegel-action

;;================================================================================================
;;=========== Kugel umkehren =====================================================================
;;================================================================================================

    (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

;;================================================================================================
;;=========== Kegel umkehren =====================================================================
;;================================================================================================

    (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
    );;kegel-umk-action

;;================================================================================================
;;=========== Besitzer zuweisen ==================================================================
;;================================================================================================

(wechslebaugruppe ()
(sd-call-cmds (change_pa_owner :new_owner Besitzer
				:parts_assemblies TempBG
				)) 
);endewechslebaugruppe

;;================================================================================================
;;=========== Kreiskante-Kreiskante ausrichten ===================================================
;;================================================================================================

  (inlinie()
 
  (setf datis1 (sd-inq-geo-props linie1 :dest-space :global))  
  
  (setf circen1 (sd-circle-center datis1))
  
  (setf cirnor1 (sd-circle-normal datis1))
   
  (setf cirstart1 (sd-circle-start-dir datis1))
   
  (setf cirrad1 (sd-circle-radius datis1))
    
  (setq flaechen1 (car (sd-call-cmds (get_selection :focus_type *sd-plane-seltype*
                                :select 
                                :by_edge_3d linie1
                                ))))
  (setq cylfl1 (car (sd-call-cmds (get_selection :focus_type *sd-cylinder-seltype*
                                :select 
                                :by_edge_3d linie1
                                ))))  
  
  (setq allfl1 (car (sd-call-cmds (get_selection :focus_type *sd-face-seltype*
                                :select 
                                :by_edge_3d linie1
                                ))))                                    
  (setq confl1 (car (sd-call-cmds (get_selection :focus_type *sd-cone-seltype*
                                :select 
                                :by_edge_3d linie1
                                )))) 
  (setq spherfl1 (car (sd-call-cmds (get_selection :focus_type *sd-sphere-seltype*
                                :select 
                                :by_edge_3d linie1
                                ))))                                                                       
                              
                              

                              
  (setf flaeinq1 (sd-inq-geo-props flaechen1 :dest-space :global))   
                                                        
  (setf cylflinq1 (sd-inq-geo-props cylfl1 :dest-space :global))   
                             
  (setf conflinq1 (sd-inq-geo-props confl1 :dest-space :global))   
                            
  (setf spherflinq1 (sd-inq-geo-props spherfl1 :dest-space :global))   
   
  (cond
    ((and flaechen1 flaechen1) (progn  
                     ;(display "in flaechen")       
                    (setf flaeinq1 (sd-inq-geo-props flaechen1 :dest-space :global))
                    (setf flnor1 (sd-plane-normal flaeinq1))  
                    );endprogn
                  )
    ((and cylfl1 cylfl1) (progn   
                  ;(display "in cylfl")
    		  (setf flnor1 (SD-CYLINDER-AXIS-DIR cylflinq1))            
    		  ;(display "nach sd-c<linderaxisdir")
                  );endprogn
                  )        
    ((and confl1 confl1) (progn   
    		;(display "confl")
    		(setf flnor1 (SD-CONE-AXIS-DIR conflinq1))            
                  );endprogn
                  )                   
    );endcond              
                  
  
 
  ;(display (format nil "flaenor1 ~a" flnor1))                             

  
  ;(display " ----  ende circ1 ----")
  ;(display "--- begin 2----")
  
  (setf datis2 (sd-inq-geo-props linie2 :dest-space :global))
  ;(display (format nil "datis2 : ~a" datis2))
  
  
  (setf circen2 (sd-circle-center datis2))
  ;(display (format nil "circen2 :~a" circen2))
  
  (setf cirnor2 (sd-circle-normal datis2))
  ;(display (format nil "cirnor2 :~a" cirnor2))
   
  (setf cirstart2 (sd-circle-start-dir datis2))
  ;(display (format nil "cirstart2 :~a" cirstart2))
   
  (setf cirrad2 (sd-circle-radius datis2))
  ;(display (format nil "cirrad2 :~a" cirrad2))
  
  
  (setq flaechen2 (sd-call-cmds (get_selection :focus_type *sd-plane-seltype*
                                :select 
                                :by_edge_3d linie2
                                )))
                                
  ;(display (format nil "flaechen2 um edge2 ~a" flaechen2)) 

  (setf fla2 (car flaechen2))  
                              
  (setf flaeinq2 (sd-inq-geo-props fla2 :dest-space :global))   
                          
  (setf flnor2 (sd-plane-normal flaeinq2))
 
  ;(display (format nil "flaenor2 ~a" flnor2))                             

 
  ;(display " -ende circ2-- ")
  
 
  
  ;Vector Radius1
  (setf PuKa1 (sd-vec-add circen1 (sd-vec-scale (sd-vec-scale cirstart1 1) cirrad1)))
  (setf VecRot1 (sd-vec-rotate cirstart1 1.5707966327 :point circen1 :direction flnor1))
  (setf PuFl1 (sd-vec-add circen1 (sd-vec-scale (sd-vec-normalize VecRot1) cirrad1)))

 
  ;Vector Radius2
  
  (setf PuKa2 (sd-vec-add circen2 (sd-vec-scale cirstart2 cirrad2)))
  (setf VecRot2 (sd-vec-rotate cirstart2 4.71238898 :point circen2 :direction flnor2))
  (setf PuFl2 (sd-vec-add circen2 (sd-vec-scale (sd-vec-normalize VecRot2) cirrad2 )))
 
  
  (setf flnorwi (sd-vec-angle-between flnor1 flnor2))
  ;(display (format nil "FlaNormWinkel ~a" flnorwi))
  
  (setf kreuzpro (sd-vec-cross-product flnor1 flnor2))
  ;(display (format nil "Kreuzprodukt ~a" kreuzpro))
  
  

(cond 
      ((and flaechen2 flaechen2) (progn

 			(sd-call-cmds (position_pa    TempBG
 				:translate :two_ptv
  				circen1 circen2
  				))  
  			;(display (format nil "kreuzpro ~a" kreuzpro))
  			
  			
				
  			(if (not (sd-vec-null-p kreuzpro :resolution 1e-20))
  			(progn
  			
  			  ;(display "kreuprod not null")
  			  (sd-call-cmds (position_pa TempBG
                     		:rotate
                     		:axis circen2 kreuzpro
                     		:rotation_angle (+ flnorwi pi)
                     		))
  			  );endprogn
  			  );endif
			
                     	
			(sd-call-cmds (change_pa_owner :new_owner Besitzer
				:parts_assemblies TempBG
				)) 
		      );endprogn
	             )
	             
	             	      
		      
);endcond


  );end inlinie





;;================================================================================================
;;=========== Zusatzfenster schließen ============================================================
;;================================================================================================

	(fensterzu ()
	  (when (sd-inq-vp-exists-p "teotemp")
	  	(progn
	    	(sd-call-cmds 
	    		(DELETE_VP "teotemp")
	    	);;sd-call-cmds 
	    );;progn
	  );;When
	);end fensterzu

;;================================================================================================
;;=========== Zusatzfenster erstellen  ===========================================================
;;================================================================================================

	(fensterauf()
  	(setf fensterrichtung (sd-call-cmds (uic_store_vp_view (sd-inq-current-vp))))
    (when (sd-inq-vp-exists-p "teotemp")
                (progn
                 	(sd-call-cmds 
                 		(DELETE_VP "teotemp")
                 	);;sd-call-cmds 
                );;progn
    );;When
    (sd-call-cmds 
    	(create_vp 
    		:name  "teotemp"
        :CORNER_1 850,850
        :corner_2 1200,1200
      );;create_vp 
    );;sd-call-cmds 
 
    (sd-call-cmds (set_vp_drawlist "teotemp" TempBG))              
    (sd-call-cmds (uic_recall_vp_view "teotemp"))
   	(sd-call-cmds (fit_vp "teotemp"))
   	(sd-call-cmds (update_screen)) 
 
	);end fensterauf


);endlocalfunction 
 
) ;enddefdialog

;;================================================================================================
;;=========== globale Funktionen =================================================================
;;================================================================================================

;;--------------------------------------------------------------------------*
;;     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 dc4-teilpos-get-cone-dir

;;-------------------------------------------------------------------------*/
;;     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 dc4-teilpos-get-sphere-dir

;;-------------------------------------------------------------------------*/
;;     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
);;defun dc4-teilpos-get-axis-dir