(in-package :gb-custom)
(use-package :OLI)

(sd-defdialog 'gb_ex_pa
:dialog-title (sd-multi-lang-string "Replace Part/Assy" :german "Teil/Bgr tauschen")
;:toolbox-button nil
:variables '(
	(quelle		:value-type :part-assembly
			:initial-value nil
			:multiple-items nil
			:prompt-text (sd-multi-lang-string "Specify new part or assembly to be used"
                                                           :german "Neues, einzusetzendes Teil oder Baugruppe angeben")
			:title (sd-multi-lang-string "Source" :german "Quelle")
			:modifies nil
			:after-input (progn
					(setq ziel nil)
					(setq wziele nil)
					)
	)
	(ziel		:value-type :part-assembly
			:initial-value nil
			:multiple-items nil
			:prompt-text (sd-multi-lang-string "Specify part or assembly to be replaced" 
                                                           :german "Altes, zu ersetzendes Teil oder Baugruppe angeben")
			:title (sd-multi-lang-string "Destination" :german "Ziel")
			:modifies nil
			:after-input (progn
					(l-check-part-parent)
					(setq wziele nil)
					)
	)
	(wziele		:value-type :part-assembly
			:initial-value nil
			:initial-optional t
			:multiple-items t
			:prompt-text (sd-multi-lang-string "Specify other parts or assemblies to be replaced" 
                                                           :german "weitere, zu ersetzende Teile oder Baugruppen angeben")
			:title (sd-multi-lang-string "Dest.opt" :german "Ziele opt.")
			:modifies nil
			:after-input (l-check-list-parent)
	)
	(dummy1 :title (sd-multi-lang-string "Delete Source" :german "Quelle loeschen"))
	(flag		:value-type	:boolean
			:initial-value nil
			:title (sd-multi-lang-string "Yes" :german "Ja")
	)
	(dummy2 :title (sd-multi-lang-string "Keep old names" :german "Alten Namen behalten"))
	(flag2		:value-type	:boolean
			:initial-value nil
			:title (sd-multi-lang-string "Yes" :german "Ja")
	)
	);variables
:ok-action '(l-ok); ok-action
:help-action '(sd-display-url (concatenate 'string (system:getenv "GBDOCDIR") "/doc/gb_ex_prt.html"))
:local-functions '(

(l-check-part-parent ()
	(when (sd-inq-obj-parent-contents-read-only-p ziel)
			(l-error-read-only)
			(setq ziel nil)
	);
	(when (equal quelle ziel)
			(l-error-quelle-ziel)
			(setq ziel nil)
	)
);

(l-check-list-parent ()
	(let (orig teil
	(l-error-read-only-f nil)
	(l-error-sys-id-f nil)
	(l-error-sel-parts-f nil))
	(setf orig (sd-inq-obj-contents-sysid ziel))
	(dolist (a-prt wziele)
		(when (sd-inq-obj-parent-contents-read-only-p a-prt)
				(setf l-error-read-only-f t)
				(setq wziele nil)
		)
		(setf teil (sd-inq-obj-contents-sysid a-prt))
		(unless (string= orig teil)
				(setf l-error-sys-id-f t)
				(setq wziele nil)
		)
		(when (equal ziel a-prt)
				(setf l-error-sel-parts-f t)
				(setq wziele nil)
		)
	)
	(when l-error-read-only-f
		(l-error-read-only)
	)
	(when l-error-sys-id-f
		(l-error-sys-id)
	)
	(when l-error-sel-parts-f
		(l-error-sel-parts)
	)
	); let
)

(l-error-read-only ()
	(sd-display-error (sd-multi-lang-string "Owner of the selected part is marked as read-only !" 
                                                                   :german "Besitzer ist schreibgeschÏtzt !"))
);

(l-error-sys-id ()
	(sd-display-error (sd-multi-lang-string "Different assemblies have been selected."
                                                :german "Es wurden verschiedene Baugruppen gewaehlt"))
);

(l-error-sel-parts ()
        (sd-display-error (sd-multi-lang-string "\"Dest.opt\" contains the destination assembly" 
                                   :german "Ziel-Baugruppe ist in \"Ziele opt.\" enthalten"))
);

(l-error-quelle-ziel ()
	(sd-display-error (sd-multi-lang-string "Same source and destination have been specified."
                                                :german "Quelle und Ziel sind identisch"))
);


(l-ok ()
	(let (prt-list name besitzer p1 p2 p3 p4 p5 p6 new-name)
	(setf p1 (sd-vec-xform (gpnt3d 0.0 0.0 0.0) :source-space ziel :dest-space :global))
	(setf p3 (sd-vec-xform (gpnt3d 1.0 0.0 0.0) :source-space ziel :dest-space :global))
	(setf p5 (sd-vec-xform (gpnt3d 0.0 1.0 0.0) :source-space ziel :dest-space :global))
	(setf new-name (sd-inq-obj-basename quelle))
	(setf prt-list (push ziel wziele))
	(dolist (a-part prt-list)
		(setf name (sd-inq-obj-basename a-part))
		(setf p2 (sd-vec-xform (gpnt3d 0.0 0.0 0.0) :source-space a-part :dest-space :global))
		(setf p4 (sd-vec-xform (gpnt3d 1.0 0.0 0.0) :source-space a-part :dest-space :global))
		(setf p6 (sd-vec-xform (gpnt3d 0.0 1.0 0.0) :source-space a-part :dest-space :global))
		(setf besitzer (sd-inq-parent-obj a-part))
		(sd-call-cmds (delete_3d a-part))
		(unless flag2
			(setf name (sd-gen-obj-basename :assembly :parent besitzer :prefix (concatenate 'string new-name ".")))
		)
		(sd-call-cmds (CREATE_MULTIPLE_PA :SHARE
			:SOURCE quelle
			:OWNER besitzer
			:NAME name
			:match_three_pts p1 p2 p3 p4 p5 p6
		))
	)
	(when flag 
		(unless (sd-inq-obj-parent-contents-read-only-p quelle)
			(sd-call-cmds (delete_3d quelle))
		)
	)
	); let

); l-ok

);local-functions
);sd-defdialog