;*********************************************************************************************
; Dateiname 		: 	SD_MoveToOrigin.lsp
; Autor         : 	Stephan Wörz
; Erstellt      :		18.01.2008
; geändert    	:
;*********************************************************************************************
; Beschreibung	:		- 	Hier geht es um folgendes:
;                       Um unserer AV die Arbeit mit Ihrem CAM-System zu vereinfachen, sollten
;                       alle Teile mit einem zu definierenden Punkt auf 0,0,0 im globalen KoSys
;                       liegen. Im Idealfall liegt am gewählten Punkt auch der Bemaßungsursprung.
;                       Unsere technischen Zeichner sollen dies mit diesem Toll erledigen können. 
;                       Wird OBJEKT aus dem Kontext einer Baugruppe gewählt, so soll ein Exemplar
;                       erstellt werden. Liegt das OBJEKT unter ROOT wird es sofort verarztet und
;                       wird dann mit den Funktionen des Tools ausgerichtet.
;
;	Optionen			:		-		Zurückspeichern des Objekts in PHOENIX(Ausrichtung in Inhaltsdatei des Objekts).
;										-		Teileprüfung durchführen
;										-		Zeigen der Vorderansicht und einpassen in Darstellungsfenster
;*********************************************************************************************
; ----------------------------------------------------------------------------------------
; ä Ì	   Ä Ø    ö Î    Ö Ú    ü Ï    Ü Û    ß Þ    ° ³	
; ----------------------------------------------------------------------------------------

; Änderungen
;


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

(sd-defdialog 'SD_MoveToOrigin	
 		:toolbox-button t
 	 	:dialog-title "Neupositionieren"
 		:variables '(
   
;; ----------------------------------------------------------------------------------------------------------------------------------------------------    	
(Objekt 			  :value-type :part-assembly
           			:prompt-text "Teil oder Baugruppe wÌhlen"
           			:title "Objekt"
           			:modifies :contents   
           			:initial-value nil
           			:initial-enable t 
          			:next-variable 'ORIGIN 
           			:after-input (progn           			
           							
           											;; Variablen zurücksetzen
           											(setf input nil)
           											 
           											;; Prüfen ob OBJEKT in ROOT steht
           											(IsInRoot)
           											
           											;wenn Objekt eine Baugruppe ist, dann Teilprüfung AUS
           											(if 
           												(sd-inq-assembly-p Objekt)           												
           												(sd-set-variable-status 'CheckPart :enable nil)           												
           												(sd-set-variable-status 'CheckPart :enable t)
           											);;if
           											
           											;nächste Variable aktivieren
           											(sd-set-variable-status 'ORIGIN :enable t) 
           											
            										;;FENSTER merken
           											(setf FENSTER (sd-inq-current-vp)) 
          										
           											     													           										    									           										
           										);end progn	


);end Objekt

;; ------------------------------------------------	----------------------------------------------------------------------------------------------------   
 (ORIGIN			:value-type :point-3d 							
 							:initial-enable nil
 							:built-in-feedback t
 							:preselection-definition-time :suppress
 							;:modifies NIL
							:prompt-text "Punkt wÌhlen der auf dem globalen Nullpunkt liegen soll"
	     				:title "Ursprung"
	     				:initial-value nil
	     				:next-variable 'Vorderansicht
	     				:after-input (progn
	     												(sd-set-variable-status 'Vorderansicht :enable t)
	     										 );;progn		
);end ORIGIN   
    
;; ----------------------------------------------------------------------------------------------------------------------------------------------------    
(Vorderansicht 	:value-type  :measure-direction
								:initial-enable nil
								:prompt-text "FlÌche/Richtung wÌhlen die Vorderseite darstellt"
								:built-in-feedback t
								:initial-direction-negative t
								:initial-value nil
								:title "Vorderansicht"
								:next-variable 'Draufsicht
								:after-input (progn
	     												(sd-set-variable-status 'Draufsicht :enable t)	     												
	     										   );;progn		
);end Vorderansicht  		

;; ----------------------------------------------------------------------------------------------------------------------------------------------------
(Draufsicht 	:value-type :measure-direction
							:initial-enable nil
							:prompt-text "FlÌche/Richtung wÌhlen die Draufsicht darstellt"
							:built-in-feedback t
							:title "Draufsicht" 
							:after-input 	(progn
															(when (sd-vec-colinear-p (first Vorderansicht)(first Draufsicht));; Wenn Vorderansicht und Draufsicht gleiche oder entgegengesetzte Richtung haben
																(progn
															  	(sd-display-message "Richtung nicht zulÌssig - Draufsicht neu wÌhlen")
															  	(setf Draufsicht nil)															  
															  );;progn															  															  
															);;when
																																																												 					
														);;progn	
																			
);end Draufsicht              
                              
;; ----------------------------------------------------------------------------------------------------------------------------------------------------

("Optionen")
;; ----------------------------------------------------------------------------------------------------------------------------------------------------
(CheckPart
      :title "TeileprÏfung durchfÏhren"
	  	:toggle-type :wide-toggle
	  	:value-type	:boolean
	  	:initial-value nil 
	  	:initial-enable t
	  	:after-input 	(progn  
	  									(if CheckPart
	  										(sd-set-variable-status 'DeleteEx :enable nil)
	  										(sd-set-variable-status 'DeleteEx :enable t)
	  									);;if
	  								);;progn

);end CheckPart
;; ----------------------------------------------------------------------------------------------------------------------------------------------------
	(zliste_orig) 


  ) ;; end variables
	

 :local-functions '(
;; ----------------------------------------------------------------------------------------------------------------------------------------------------
	(MoveHome (Objekt ORIGIN Vorderansicht Draufsicht)
			(let (vpt upt orig Vorne Oben)
		  	(setf upt (sd-vec-add ORIGIN (first Draufsicht)))
		  	(setf vpt 		(first Vorderansicht))
		  	(setf orig 		(make-gpnt3d :x 0 :y 0 :z 0))
		  	(setf Vorne 	(make-gpnt3d :x 0 :y 0 :z -1))
		  	(setf Oben 		(make-gpnt3d :x 0 :y 1 :z 0))
		  	(sd-call-cmds (position_pa (sd-inq-obj-pathname Objekt) :match_pt_dir_pt ORIGIN orig vpt Vorne upt Oben))
			);;let
	);;MoveHome
;; ----------------------------------------------------------------------------------------------------------------------------------------------------
	(Checkfunc ()
			(sd-call-cmds 
			   (check_part
					:objects Objekt
					:LABELS :ON
					:KEEP_LABELS :ON
					:VERBOSE :ON
					:WARNINGS :OFF
					:MAXIMAL_CHECK
				);end check_part
			);end sd_call_cmds
	);end checkfunc
;; ----------------------------------------------------------------------------------------------------------------------------------------------------
	(IsInRoot ()
		(sd-call-cmds
			(if 
				(not (sd-inq-parent-obj Objekt))
				
				(progn									
					(DirektVerarbeiten)
				);;progn
				
				(progn
					(MakeExemplar)						
				);;progn
				
			);;if
		);;sd-call-cmds
	);end IsInRoot
;; ----------------------------------------------------------------------------------------------------------------------------------------------------
	(DirektVerarbeiten ()
		(progn
			(Zusatzfenster OBJEKT)		
		);;progn
	);DirektVerarbeiten
;; ----------------------------------------------------------------------------------------------------------------------------------------------------
	(MakeExemplar ()
		(progn
			(create_multiple_pa
				:SHARE
				:NAME 			(format nil"~A_NEU" (sd-inq-obj-basename OBJEKT))	
				:OWNER 			"/"
				:SOURCE 		(sd-inq-obj-pathname OBJEKT)		
			);;create_multiple_pa
			;;Exemplar der Variablen OBJEKT zuweisen (... damit Exemplar ausgerichtet wird)
			(setf OBJEKT (sd-pathname-to-obj  (format nil "/~A_NEU" (sd-inq-obj-basename OBJEKT)))) 
			(Zusatzfenster OBJEKT)
		);;progn

	);end MakeExemplar		

;; ----------------------------------------------------------------------------------------------------------------------------------------------------
  ); end local-functions
  
	:ok-action '(progn
									;Objekt in entsprechender Ausrichtung positionieren									
									(MoveHome Objekt ORIGIN Vorderansicht Draufsicht)									
										
									;auswerten ob Option "Teileprüfung" gesetzt ist						
										(if CheckPart 
											(progn
												(Checkfunc)
											);;progn
										) ;;if
	
									;OBJEKT in Zusatzfenster einpassen
									(ShowObjekt FENSTER OBJEKT)
									;Zusatzfenster löschen
									;(delete_vp "Zusatzfenster")

							);end progn
;; ----------------------------------------------------------------------------------------------------------------------------------------------------	
  :cleanup-action  '(progn 												 											
																				
											);end progn
;; ----------------------------------------------------------------------------------------------------------------------------------------------------										
  :cancel-action 	'(progn
  									;Zusatzfenster löschen
										(when 
	  									(sd-inq-vp-exists-p "Zusatzfenster")
	     								(sd-call-cmds (delete_vp "Zusatzfenster"))
	  								);;when										
  								);;progn
;; ----------------------------------------------------------------------------------------------------------------------------------------------------
  :help-action '(sd-display-message 
  "Notizen zur Entwicklung:

FUNKTIONEN:
  
- Objekte die nicht unter ROOT liegen --> Exemplar unter Root
- Optional : TeileprÏfung
- Optional : Speichern in Phoenix
- Optional : Teil einpassen
- Optional : Warnen oder reservieren
     
FEHLER: 

- Objekte sofort reservieren --> Objekte mit Schloss nicht wÌhlbar!?
- Zusatzfenster tut noch nicht"
     :title "Notizen"
     :push  "OK"
    
     );;sd-display-message
;; ----------------------------------------------------------------------------------------------------------------------------------------------------

) ;; end defdialog


;;globale Funktionen

(defun Zusatzfenster (OBJEKT)

  (setf fensterrichtung (sd-call-cmds (uic_store_vp_view (sd-inq-current-vp)))) ;;????????????  
	  (when 
	  		(sd-inq-vp-exists-p "Zusatzfenster")
	     	(sd-call-cmds (delete_vp "Zusatzfenster"))
	  );;when
             
   		(sd-call-cmds 
   			(create_vp 
   				:name  "Zusatzfenster"
          :CORNER_1 40,40
          :corner_2 800,800))
 
      (sd-call-cmds (set_vp_drawlist "Zusatzfenster" OBJEKT))
      (sd-call-cmds (uic_recall_vp_view "Zusatzfenster"))
      (sd-call-cmds (fit_vp "Zusatzfenster"))
      (sd-call-cmds (update_screen)) 
);;Zusatzfenster
;; ----------------------------------------------------------------------------------------------------------------------------------------------------
	(defun ShowObjekt(FENSTER OBJEKT)

			(setf zliste_orig (sd-INQ-VP-DRAWLIST-OBJECTS FENSTER))
			(sd-call-cmds 
				(progn
					(set_vp_drawlist FENSTER OBJEKT)
					;Vorderansicht zeigen
					(uic_set_vp_direction 0,0,-1 FENSTER)
					;in Fenster einpassen
					(fit_vp FENSTER)
					(set_vp_drawlist FENSTER zliste_orig)
				);;progn
			);;sd-call-cmds
		);;ShowObjekt