;*********************************************************************************************
; Dateiname 	: 	SD_Absolute_Masse.lsp   
; Autor         : 	Stephan Wörz            
; Erstellt      :	23.04.2005              
; geÌndert    	:	01.02.2008	div. Änderungen
;*********************************************************************************************
; Beschreibung	:	- Setzen einer absoluten Teilemasse  	
;										-	
;*********************************************************************************************
; ä Ì	   Ì Ø    ö Î    Ö Ú    ü Ï    Ü Û    ß Þ    ° ³	
;*********************************************************************************************

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

(sd-defdialog 'SD_Absolute_Masse

:dialog-title "Absolute Masse" 
:toolbox-button t

:variables 
   '( 
 
("Anwenden auf...") 
      
	(Objekt	
	  :value-type :part-assembly
	  :modifies nil
	  :title "Teil/Baugr."
	  :multiple-items t
	  :initial-value nil
	  :next-variable 'masse 
	  :after-input   		(progn
												
												;;prüfen ob es sich bei 'OBJEKT' um ein Teil oder eine Baugr. handelt	  	  											
	  										(if (sd-inq-part-p (first Objekt))
	  										
	  											(progn	  										
														(setf parts Objekt)
														(CheckParent)
														(AktuelleMasse);; aktuelle Masse 																		
													);;progn
													
													(progn													  
														(setf parts (sd-call-cmds (get_selection :focus_type *sd-part-seltype* :select :recursive :in_assembly Objekt)))
														(if (sd-inq-obj-contents-read-only-p (first Objekt))
															(progn
																(setf DelTeilEig nil)
																(sd-set-variable-status 'DelTeilEig :enable nil)
															);;progn	
														);;if																											
														(AktuelleMasse);; aktuelle Masse 
													);;progn
													
												);;if											
												(CheckStructure)
											);;progn
	);;Objekt
	      
("absolute Teilemasse") 
	      				  
	(masse  
 		:value-type :number
 		:initial-enable t
 		:title "Ziel-Masse [g]"
 		:initial-value 0
 		:proposals ("0.0001")
 		:prompt-text "Masse in Gramm eingeben"
 		:initial-optional T
	);;masse
	
	(Istmasse  
 		:value-type :display-only
 		:initial-enable t
 		:title "Ist-Masse  [g]"
 		:initial-value 0
 		:prompt-text "aktuelle Masse"
 		:initial-optional T
	);;Istmasse
	
("Optionen")
	    
	(DelTeilEig
   	:title "Exemplardichte lÎschen"
	 	:toggle-type :wide-toggle
	 	:value-type	:boolean
	 	:initial-value T
	 	:after-input	
         	 	(progn
         	    (setf nurBericht nil)
		 				);end progn
	);end DelTeilEig

("Info")

	(Info
		:title "Kurzanleitung"
		:toggle-type :wide-toggle
		:push-action	(sd-display-message 
			"Das Tool bietet folgende Funktion:
			
- Im Feld 'Ist-Masse' wird die derzeitliche Masse angezeigt
    	
- In das Feld 'Ziel-Masse' wird die neue Masse eingegeben
  --> bei schreibgeschÏtzten Teilen keine Eingabe mÎglich
  --> wenn in der Struktur der Baugruppe schreibgschÏtzte Teile
        drin sind ist keine Eingabe mÎglich

- Ist die Option 'Exemplardichte lÎschen' angehakt, so wird diese gelÎscht.
  --> Ist der Besitzer schreibgeschÏtzt, steht diese Option nicht zur VerfÏgung!  
  
Bei gewÌhltem Teil			
--> Zielmasse wird an Teil Ïbertragen

Bei gewÌhlter Baugruppe
--> Zielmasse wird gleichmÌÞig auf alle Teile der Bgr. verteilt"
   :title "Absolute Masse - Kurzanleitung"
   :push  "Alles Klar!"
  
   );;sd-display-message		
);;Info  	 		

	    	       
) ;end variables



;;================================================================================================
;;=========== Dialog-Button-Actions ==============================================================
;;================================================================================================                     
:ok-action
  '	(progn
			(if (> masse 0)
				(progn								
				(VolumenErmitteln)
    		(setf NeueDichte (/ masse VolGes))
    		(MasseVergeben)
	    	);;progn	    
	    );;if
	   	(ExDichteWeg)
  	);;progn
;;================================================================================================
:cancel-action
 '	(progn

   	);;progn
;;================================================================================================
:help-action
 '	(progn

   	);;progn

;;================================================================================================
;;=========== Lokale Funktionen ==================================================================
;;================================================================================================
:local-functions
 '(

;;================================================================================================
;;=========== Funktion zum berrechnen der aktuellen Masse des gewÌhlten Objekts ==================
;;================================================================================================
(AktuelleMasse()
	(progn
		(setf Istmasse 0)
 		(dolist (part parts)
			(setf Istmasse (+ Istmasse  (sd-call-cmds (get_vol_prop :for_part :part part :mass ))))		
 		);;dolist 
 	);;progn
);;AktuelleMasse

;;================================================================================================
;;=========== Funktion zum ermitteln des Volumens von 'OBJEKT' ===================================
;;================================================================================================
(VolumenErmitteln ()
 (progn
  (setf VolGes 0)
  (dolist
  	(part parts)
    	(progn           
		  	(setf TeilVolumen (sd-call-cmds (get_vol_prop :for_part :part PART :volume))) 
		  	(setf VolGes (+ VolGes TeilVolumen))		 
			);endprogn
	);dolist	           
  );endprogn  
);end VolumenErmitteln

;;================================================================================================
;;===========  =========================
;;================================================================================================
(MasseVergeben ()

				(progn
				  (setf Gwicht 0)
         	(dolist
           	(part parts)					;Element aus 'parts' wird an part gebunden
              (progn     
;                (if DelTeileig		;wenn DelTeileig dann....
;   		     					(sd-call-cmds (set_part_inst_density :parts part :clr))	;Exemplardichte von 'part' wird gelöscht		     
;		  					);;if       
		  				(sd-call-cmds (set_part_base_density :parts PART :dens NeueDichte)) ;hier wird 'part' die neue Dichte gegeben 
		  				(setf Gwicht (+ Gwicht (sd-call-cmds (get_vol_prop :for_part :part PART :mass )))) ;hier wird die neue Masse von 'part' berechnet
							);;progn
					);;dolist
									
   		  	(sd-display-message 
						(format nil "...wurde geÌndert! ~%~% Gesamtmasse = ~,2F gramm" Gwicht)
   						:title (format nil "~A" (sd-inq-obj-basename (first Objekt)))
   						:push  "OK"
					);;sd-display-message   		     
				);;progn

);MasseVergeben

;;================================================================================================
;;=========== Exemplardichte entfernen ===========================================================
;;================================================================================================
(ExDichteWeg ()
   	(if DelTeileig		;wenn DelTeileig dann....
   		(dolist (part parts)
   			(sd-call-cmds (set_part_inst_density :parts part :clr))	;Exemplardichte von 'part' wird gelöscht	
   		);;dolist	     
		);;if       
);;ExDichteWeg

;;================================================================================================
;;=========== Prüfen ob ein schreibgeschütztes Objekt in der Struktur enthalten ist ==============
;;================================================================================================
(CheckStructure ()
	(progn
		(sd-set-variable-status 'masse :enable t)
		(dolist (part parts)
			(if (sd-inq-obj-contents-read-only-p part)
				(sd-set-variable-status 'masse :enable nil)
			);;if
		);;dolist
	);;progn
);;CheckStructure

;;================================================================================================
;;===========prüfen ob das Elternobjekt schreibgeschützt ist =====================================
;;================================================================================================
(CheckParent ()
	(progn
	  (setf DelTeilEig t)
	  (sd-set-variable-status 'DelTeilEig :enable t)
		(if (sd-inq-obj-parent-contents-read-only-p (first Objekt))
			(progn
				(setf DelTeilEig nil)
				(sd-set-variable-status 'DelTeilEig :enable nil)
			);;progn											
		);;if	
	);;progn
);;CheckParent


);endlocalfunction 

) ;enddefdialog