;*******************************;**************************************************************
; Dateiname 		: 	Abmessungen.lsp
; Autor         : 	wz
; Erstellt      :		12.09.2007
; geändert    	:
;*********************************************************************************************
; Beschreibung	:		-> Dummyteil in neuem Datenfenster, dann fläche wählen	
;										-	
;*********************************************************************************************
; ----------------------------------------------------------------------------------------
; ä Ì	   Ä Ø    ö Î    Ö Ú    ü Ï    Ü Û    ß Þ    ° ³	
; ----------------------------------------------------------------------------------------

; Änderungen
;


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

(setf box_feedback nil)

(sd-defdialog 'Teilemasse-anzeigen
 :toolbox-button t 
 ;;:dialog-control :sequential
 :variables '(
 
   (the-face
     :selection *sd-plane-seltype*
     :no-highlight t ;;selektierte Flaeche wird dann nicht hervorgehoben
     :prompt-text "AuÞenflÌche des Teiles selektieren um die Fertigmasse anzuzeigen."
     :initial-value nil
     :title "Ebene FlÌche:"
     :before-input
     (sd-end-feedback box_feedback)
     :after-input
     	(progn
       	(sd-set-variable-status 'Objekt :enable t)
     	);; end progn
   );; end the-face
   
    	
		(Objekt 			  :value-type :part-assembly    
           					:prompt-text "Teil oder Baugruppe wÌhlen"
           					:title "Objekt"
           					:modifies nil 
           					:initial-value nil
           					:initial-enable nil 
           					:after-input (progn         					
          													(if (sd-inq-part-p  Objekt)  ;; wenn Objekt ein Teil ist...
          														(progn
          															(setf the-part (sd-pathname-to-obj(sd-inq-obj-pathname objekt)))
          															(MakeBox)
          															(calculate)          															
          														);; end progn
          													);; end IF
          														
          													(if (sd-inq-assembly-p Objekt)  ;; wenn Objekt eine Baugruppe ist
          														(progn
          	;;													  (HideAssy)
          															(CreateDummy)
          															(SelectParts)
          															(Unite3D)
          															(setf the-part  (sd-pathname-to-obj "/Dummy"))        															
																				(MakeBox)
																				(calculate)
																				(KillDummy)
          														);; end progn
          													);; end if
          													          												
          												);; end progn
    );end Objekt
   
   
  ) ;; end variables


 :local-functions '(
;; ----------------------------------------------------------------------------------------------------------------------------------------------------
	;; Funktion zum ausblender der Orginalbaugruppe
		(HideAssy ()
				(remove_from_vp_drawlist (sd-inq-current-vp) :with-wp :no-hilite Objekt complete)		
		);; end HideAssy

;; ----------------------------------------------------------------------------------------------------------------------------------------------------
	;; Funktion zum erstellen der BOX
	  (MakeBox ()
	     (setf hdir (sd-plane-normal (sd-inq-geo-props the-face :dest-space :global)))
       (setf ldir (sd-plane-u-dir (sd-inq-geo-props the-face :dest-space :global)))
       (setf z-dir hdir)
       (setf x-dir ldir)       
       (setf the-box (sd-inq-exact-box the-part z-dir x-dir :source-space :global :dest-space :global))
       (setf box_feedback (sd-start-box-feedback (sd-box-points (first the-box) (second the-box) z-dir x-dir) :color 1.0,1.0,0.5))	  
	  );; end MakeBox
;; ----------------------------------------------------------------------------------------------------------------------------------------------------
  ;; Funktion zu erstellen eines Hilfsteils
  	(CreateDummy ()
  			(progn
  			 	(sd-call-cmds (create_part :owner "/" :name "Dummy"))
        );end progn	  	
  	);end CreateDummy
;; ----------------------------------------------------------------------------------------------------------------------------------------------------   
	;; Funktion zum löschen des Hilfsteils
		(KillDummy ()
				(progn
					(sd-call-cmds (delete_3d the-part))
				);end progn
		);; end KillDummy
;; ----------------------------------------------------------------------------------------------------------------------------------------------------
  ;; Function zum vereinen aller Teile
    (Unite3D ()
      	(sd-call-cmds 	(unite_3d
      						:blank "/Dummy"
      						:tools Teile 
      						:keep_tools :yes
;;      						:glue :no       						     						
    					);;unite_3d
;;    		:success (display "Alles OK!!!!")
      	:failure (sd-display-error (format nil "~a" (sd-inq-error-obj :message)))
    	);;sd-call-cmds
    );end Unite3D    
;; ----------------------------------------------------------------------------------------------------------------------------------------------------
;; 	Funktion zum wählen aller Teile rekursiv in Baugruppe       
    (SelectParts ()
		(setf Teile  (sd-call-cmds (get_selection :focus_type *sd-part-seltype* :allow_face_part :allow_wire_part :select :recursive :in_assembly Objekt)))
	);end SelectParts        
;; ----------------------------------------------------------------------------------------------------------------------------------------------------
;; Function zum ermitteln der Daten
		(Calculate ()
			(let (Laenge Breite Hoehe fertig-masse aufmass zuschnitt masse volumen aussenabmass)
;;    (sd-end-feedback box_feedback)
    ;; alle Punkte der Umgrenzungsbox messen und auswerten
    (setf Laenge (sd-call-cmds (measure_dist :between_points (nth 3 (sd-box-points (nth 1 the-box) (nth 0 the-box) z-dir x-dir))
                                                             (nth 0 (sd-box-points (nth 1 the-box) (nth 0 the-box) z-dir x-dir)))))
    (setf Breite (sd-call-cmds (measure_dist :between_points (nth 1 (sd-box-points (nth 1 the-box) (nth 0 the-box) z-dir x-dir))
                                                             (nth 0 (sd-box-points (nth 1 the-box) (nth 0 the-box) z-dir x-dir)))))
    (setf Hoehe  (sd-call-cmds (measure_dist :between_points (nth 4 (sd-box-points (nth 1 the-box) (nth 0 the-box) z-dir x-dir))
                                                             (nth 0 (sd-box-points (nth 1 the-box) (nth 0 the-box) z-dir x-dir)))))
    ;; alle Negativ-Laengen in positive umwandeln
    (when (< Laenge 0)
      (setf Laenge (- Laenge))
    )
    ;; alle Negativ-Breiten in positive umwandeln
    (when (< Breite 0)
      (setf Breite (- Breite))
    )
    ;; alle Negativ-Hoehen in positive umwandeln
    (when (< Hoehe 0)
      (setf Hoehe (- Hoehe))
    )
    (setq VOLUMEN
      (sd-call-cmds
        (get_vol_prop
	        :for_part
	        :part_asmb (sd-inq-obj-pathname the-part)
	        :volume
        )
	      :failure (sd-display-error (format nil "~a ~%=> Beim Berechnen des Volumens !" (sd-inq-error-obj :message)))
	    );sd-call-cmds
    );;setq volume
    
    ;; nun gibt es mehrere alternativen
    (display (format nil "  ~%~%Aussenabmasse: ~A" (sd-inq-obj-pathname objekt)))

    ;; Aussenabmassliste von gross nach klein sortieren
    (setf aussenabmass (sort (list Laenge Breite Hoehe) #'>))
    
    ;; Werte im Display gerundet auf 2 Kopmastellen ausgeben
    (display (format nil " ~a x ~a x ~a in mm"
               (sd-num-to-string (nth 0 aussenabmass) 2)
               (sd-num-to-string (nth 1 aussenabmass) 2)
               (sd-num-to-string (nth 2 aussenabmass) 2)
             )
    );; end display


    ) ;; end let 
    );; end calculate
;; ----------------------------------------------------------------------------------------------------------------------------------------------------

);; end local-functions

	:ok-action '()
	
  :cleanup-action   '(sd-end-feedback box_feedback)
  
) ;; end defdialog