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

; ü=Ï ; ä=Ì ; ö=?? ; Ü=Û ; Ä=Ø ; Ö=Ú ; Ø=Ò; µ=ó
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(sd-defdialog 'BG_aufloesen
	:dialog-title "BG aufloesen"
	:variables  
	'(
		(bg 		:selection		(*sd-object-seltype*) ;legt den Typ des Eingabefeldes fest
					:title			"Baugruppe"	 	 ;Titel des Eingabefeldbuttons 
					:prompt-text	"Bitte die aufzuloesende Baugruppe angeben"	;Text in der Aufforderungsleiste
		); end Eingabefeld
		(next		:push-action 	(naechste)
					:title			"NÌchste"
		)
	); end Variables


	:local-functions	; definition der lokalen Funktionen
	'(
		(naechste()
			(aufloesen bg)
		)

		;;(make-newname (prefix postfix)
		;;(format nil "~A.~A" prefix postfix))

		(aufloesen (bg) 	; definition der ersten Funktion		

			(let* ((geschwister (oli:sd-inq-obj-children (sd-inq-parent-obj bg)))
				(geschwisternamen (mapcar #'sd-inq-obj-basename geschwister)))

				(PA_UNSHARE :source bg :onelevel :on)

				(dolist (elem (sd-inq-obj-children bg))
					(let ((elem-name (sd-inq-obj-basename elem)))
						(when (member elem-name geschwisternamen :test #'sd-string=)
						(setf elem-name 
						(sd-gen-obj-basename :part :parent (sd-inq-parent-obj bg) 
											 :prefix (format nil "~A." elem-name)))
						); end when
					;;(display elem-name)
					(CHANGE_NAME_PA :part_asmb (sd-inq-obj-pathname elem) :name elem-name) ; Teile mit neuem Namen versehen
					);end let
				(CHANGE_PA_OWNER	;neuen Besitzer für die Teile der Baugruppe festlegen
					:new_owner
					(sd-inq-obj-pathname (sd-inq-parent-obj bg))
					:parts_assemblies
					(sd-inq-obj-pathname elem)
				); end change owner
					;;(display "Teil erfolgreich in umgesetzt!")
				);end dolist	
				(DELETE_3D bg)

			); end let*
		) ;end der Funktion 

	) ; end der lokalen Funktionsdeklaration

	:ok-action '(aufloesen bg) ; definition der Aktion bei klick auf OK	

);end sd-defdialog

(defun build-testcase1()			; Makro um eine Testbaugruppe zu erstellen
  (delete_3d :all_at_top)
  (create_assembly :name "a1" :owner "/")
  (create_assembly :name "a2" :owner "/a1")
  (create_part :owner "/a1" :name "p1")
  (create_part :owner "/a1/a2" :name "p1")
  (create_part :owner "/a1/a2" :name "p42"))