;;--------------------------------------------------------------------------*
;;  Dateiname: SD_Import-ordnen.lsp
;;  Version  : 3.1
;;  Datum    : 14.01.2016
;;  Author   : BFE
;;--------------------------------------------------------------------------*
;;  Unterstützt das Einordnen gewählter Teile in eine Struktur
;;--------------------------------------------------------------------------*
;;Versionierung
;;  1.0 erste Version
;;  2.0 neue Funktionen: ausblenden, BG erzeugen
;;  3.0 Wahlfunktion Verschieben od. Exemplar erstellen
;;  3.1 Display Feld hinzu + VP optimiert
;;  4.0 Umstrukturierung und Ergänzung => in VP darstellen
;;  5.0 Kopieren hinzugefügt und Lisp optimiert (MiBr)
; --------------------------------------------------------------------------*
(in-package  :mibr)
(use-package :oli)

;;--------------------------------------------------------------------------*
(sd-defdialog 'Import-ordnen
:dialog-title "Import-ordnen"
:toolbox-button t
:after-initialization '(progn	(when 	(sd-inq-vp-exists-p "geordnet")
										(sd-call-cmds (delete_vp  "geordnet"))
								);;when
                       );;progn
:variables
'(
	(Optionen :expand-shrink (ausblenden neues-Fenster op-farben EntferneFarbe EntferneExemplarFarbe))
	(ausblenden			:value-type :boolean
						:toggle-type :wide-toggle
						:title (sd-multi-lang-string "hide after selection" :german "Teil ausblenden")
						:initial-value t
						:persistent-data-storage t
	);;ausblenden
		
	(neues-Fenster		:value-type :boolean
						:toggle-type :wide-toggle
						:title "in neuem Fenster darstellen"
						:initial-value nil
						:persistent-data-storage t
	);;neues-Fenster
	(op-farben			:title "Farben")
	(EntferneFarbe		:value-type :boolean
						:toggle-type :wide-toggle
						:title "Flächenfarben löschen"
						:initial-value nil
						:persistent-data-storage t
	);;EntferneFarbe	
	(EntferneExemplarFarbe	:value-type :boolean
							:toggle-type :wide-toggle
							:title "Exemplarfarben löschen"
							:initial-value nil
							:persistent-data-storage t
	);;EntferneExemplarFarbe
	("Baugruppe erzeugen")
	(BG-neu				:value-type :string
						:title "BG Name"
						:prompt-text "Namen der neuen Baugruppe angeben"
						:initial-optional t
	)
	(Ziel-BG			:value-type :assembly
						:title "Zielbaugruppe"
						:prompt-text "Zielbaugruppe angeben"
						:initial-value (sd-pathname-to-obj "/")
						:modifies :contents
	)
	(button-bg			:push-action (BG-erzeugen)
						:title "BG erzeugen"
						:toggle-type :wide-toggle
	)
	("Elemente verschieben")  
	(check-kopie		:title "Kopie"
						:toggle-type :grouped-toggle
						:value-type :boolean
						:initial-value nil
	)
	(check-exemplar		:title "Exemplar"
						:toggle-type :grouped-toggle
						:value-type :boolean
						:initial-value t
	)
	(check-verschieben	:title "Verschieben"
						:toggle-type :wide-toggle
						:value-type :boolean
						:initial-value nil
	)
	(Teil-BG			:selection *sd-3d-object-seltype*
						:title "Teil/BG"
						:prompt-text "zu verschiebende(s) Teil/BG angeben"
						:multiple-items t
						:initial-visible nil
						:after-input (when	teil-bg                     
										(if (equal ausblenden t)
											;#funktion wenn wahr    
											(progn	(dolist (teil-bg-einzeln teil-bg)
														(sd-call-cmds (remove_from_vp_drawlist (sd-inq-current-vp) (SD-INQ-OBJ-PATHNAME teil-bg-einzeln))) ;Teil ausblenden
														(when EntferneFarbe (DeleteFaceColor teil-bg-einzeln))
														(when EntferneExemplarFarbe (DelExCol teil-bg-einzeln))                           
													);;dolist
													(when BG-neu (BG-erzeugen))
													(verschieben)
													(sd-call-cmds (remove_from_vp_drawlist (sd-inq-current-vp) (SD-INQ-OBJ-PATHNAME Ziel-BG)))
													(when neues-Fenster (Objekte_im_neuen_Fenster_darstellen Ziel-BG t))        
											);end progn
											;#funktion wenn falsch
											(progn	(dolist (teil-bg-einzeln teil-bg)
														(when EntferneFarbe (DeleteFaceColor teil-bg-einzeln))
														(when EntferneExemplarFarbe (DelExCol teil-bg-einzeln))                           
													);;dolist
													(when BG-neu (BG-erzeugen))
													(when EntferneFarbe (DeleteFaceColor teil-bg-einzeln))
													(verschieben)
													(when neues-Fenster (Objekte_im_neuen_Fenster_darstellen Ziel-BG t))
											);;progn
										);end if
									 );end when teil-bg         
	);;Teil-BG  
);;variables
:mutual-exclusion '(check-verschieben  check-exemplar check-kopie)
:local-functions'(
(verschieben ()
	(let ((default_part (sd-inq-curr-part))) ;Aktives Teil sichern
		(dolist (teil-bg-einzeln teil-bg)
			(cond 	(check-verschieben	(sd-call-cmds	(change_pa_owner 	:new_owner Ziel-BG
																			:parts_assemblies
																			:START  teil-bg-einzeln
																			:SELECT_DONE
														);;change_pa_owner
										)
					)
					(check-exemplar		(sd-call-cmds	(create_multiple_pa :share
																			:source Teil-BG
																			:owner Ziel-BG
														);;create_multiple_pa 
										)
					)
					(check-kopie		(sd-call-cmds	(create_multiple_pa	:copy 
																			:onelevel :on
																			:source Teil-BG
																			:owner Ziel-BG
														);;create_multiple_pa 
										)
										(sd-call-cmds (current_part default_part)) ;Gesichertes aktives Teil wieder aktivieren 
					)
			)
		) ;;dolist
		(SD-SET-VARIABLE-STATUS 'Teil-BG :value nil)
	);;let
);;verschieben

(BG-erzeugen ()
	(let ()
		(sd-call-cmds 	(create_assembly	:name BG-neu
											:owner Ziel-BG
						)
		)
	(SD-SET-VARIABLE-STATUS 'Ziel-BG :value (sd-pathname-to-obj (format nil "~A\/~A"  (sd-inq-obj-pathname Ziel-BG) BG-neu)))
	(SD-SET-VARIABLE-STATUS 'BG-neu :value nil)
	);;let
);;end BG-erzeugen
);;end local functions
:ok-action '()
:cancel-action '()
:prompt-variable 'Teil-BG
);;sd-defdialog

;;;;-----------------------Globale Funktionen -----------------------------------------------

(defun Objekte_im_neuen_Fenster_darstellen (Teile einpassen)
	(let ((vp-alt (sd-inq-current-vp)) (Ansicht_merken_1 (sd-inq-vp-camera (sd-inq-current-vp))))
		(if (sd-inq-vp-exists-p "geordnet")
			(progn (sd-set-current-vp "geordnet") (sd-call-cmds (set_vp_drawlist "geordnet" :with-wp :vp-fit Teile update_screen)))
			(progn (sd-call-cmds (create_vp :name "geordnet" )) (sd-call-cmds (set_vp_drawlist "geordnet" :with-wp :vp-fit Teile update_screen)))
		);;if
		;(sd-call-cmds (draw_only_in_new_vport Teile))
		(sd-call-cmds (fit_vp "geordnet"))
		(sd-set-vp-camera (sd-inq-current-vp) Ansicht_merken_1 :smooth nil)
		(oli:sd-call-win-command-by-sysid #xE134)
		(sd-set-current-vp vp-alt)
	);;let
);;Objekte_im_neuen_Fenster_darstellen
;;----------------------------------------------------------------------
;; Funktion zum löschen ALLER Flächenfarben ausser den reservierten
(defun DeleteFaceColor (3D-Objekt)
	(setf FacesToClear nil)
		;;wenn 3D-Objekt ein Teil ist 
        (when 	(sd-inq-part-p 3D-Objekt)
				(sd-call-cmds (get_selection 	:focus_type *sd-face-seltype* 
												:check_function #'SelectReserverdFaceColors
												:select :selected_part 3D-Objekt :all_3d)
												:failure (setf FacesToClear nil)
												:success (setf FacesToClear *SD-ACTION-RESULT*)
				);;sd-call-cmds
				(dolist (SingleFace FacesToClear)                          
					(sd-call-cmds 	(face_prop	:the_face SingleFace
												:COLOR :OFF                                                                         
									);;face_prop
					)
				);;dolist
		);;when
);;DeleteFaceColor
;;----------------------------------------------------------------------
;; ... das ist die >> :check_function <<
;; auf reservierte Flächenfarben prüfen
(defun SelectReserverdFaceColors (FaceToCheck)          
	(if (not (or  ;; wenn Farbe nicht Passung, oder nicht Gewinde, ...  >>> dann wird gelöscht!
			   (equal (sd-inq-face-color FaceToCheck) (gpnt3d 0.0					1.0					1.0));; Cyan 26 Kernfläche, Einsatzfläche  
			   (equal (sd-inq-face-color FaceToCheck) (gpnt3d 0.50196081399917603	0.50196081399917603 1.0));; Marine 28 Artikelgeometrie  
			   (equal (sd-inq-face-color FaceToCheck) (gpnt3d 0.0					0.0					1.0));; Blau 12 Kühlung                                                                                          
			   (equal (sd-inq-face-color FaceToCheck) (gpnt3d 1.0					0.0					1.0));; Magenta 30 Gewinde aller Art                                                                                           
			   (equal (sd-inq-face-color FaceToCheck) (gpnt3d 1.0					0.60000002384185791	0.0));; Orange 06 Passungsfarbe
			   (equal (sd-inq-face-color FaceToCheck) (gpnt3d 1.0					1.0					0.0));; Gelb 08 Tuschierung
			   (equal (sd-inq-face-color FaceToCheck) (gpnt3d 1.0					0.0					0.0));; Rot 04 Korrekturen
			);;or
		);;not        
	:Ok
	:filter
	);;if
);;SelectReserverdFaceColors
;;----------------------------------------------------------------------
;; Löschen der Exemplarfarbe
(defun DelExCol (3D-Objekt)
	(if (sd-inq-part-p 3D-Objekt)
		(progn 	(sd-call-cmds 	(part_prop	:the_part  3D-Objekt             
											:COLOR :OFF	;Exemplarfarbe :OFF = KEINE >> setzt auch Exemplarkantenfarbe zurück!!     
								);;part_prop
				)
		);;progn 
	);;if      
);;DelExCol