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

(sd-defdialog 'cp_ex
:dialog-title (sd-multi-lang-string "Selec.Unshare" :german "Eigenst.Exempl.")
;:toolbox-button nil
:variables '(
	(flag		:initial-optional t)
	(prt-list	:value-type :part-assembly
			:initial-value nil
			:multiple-items t
			:prompt-text (sd-multi-lang-string "Specify the parts or assemblies for which to create a selective instances."
                                                           :german "Exemplarische Teile oder Baugruppen eingeben")
			:title (sd-multi-lang-string "Part/Assy" :german "Teile/Baugr")
			:modifies nil
			:after-input (progn
					(setf flag nil)
					(l-check-list prt-list)
					)
	)
	);variables
:ok-action '(l-ok); ok-action
:local-functions '(
(l-error ()
	(sd-display-error (sd-multi-lang-string "Different parts have been selected. Only instances of the same object can be specified."
                                   :german "Es wurden unterschiedliche Teile gewÌhlt. Es dÏrfen nur Exemplare gewÌhlt werden"))
        )
(l-error1 ()
	(sd-display-error (sd-multi-lang-string "Owner is marked as read-only."
                                                :german "Besitzer hat Schreibschutz"))
        )
(l-check-list (list)
	(let (orig)
	(setf orig (sd-inq-obj-contents-sysid (first list)))
	(dotimes (i (length list))
		(setf teil (sd-inq-obj-contents-sysid (nth i list)))
		(unless (string= orig teil)
			(setf flag 'e)
		)
	);
	(when (string= flag 'e)
		(l-error)
		(setq prt-list nil)
	);
	(dolist (a-prt list)
		(when (sd-inq-obj-parent-contents-read-only-p a-prt)
				(setf flag 'f)
		)
	);dolist
	(when (string= flag 'f)
		(l-error1)
		(setf prt-list nil)
	)
	);let
);l-check	

(l-ok () 
	(let (p1 p2 p3 p4 p5 p6 tmp-name orig besitzer)
	(setf tmp-name (sd-gen-obj-basename :assembly :parent "/"))
	(sd-call-cmds (CREATE_MULTIPLE_PA :COPY :owner "/" :source (first prt-list) :onelevel :on :name tmp-name))
	(setf orig (sd-pathname-to-obj (concatenate 'string "/" tmp-name)))
	(setf p1 (sd-vec-xform (gpnt3d 0.0 0.0 0.0) :source-space orig :dest-space :global))
	(setf p3 (sd-vec-xform (gpnt3d 0.0 1.0 0.0) :source-space orig :dest-space :global))
	(setf p5 (sd-vec-xform (gpnt3d 1.0 0.0 0.0) :source-space orig :dest-space :global))
	(dolist (a-part prt-list)
		(setf name (sd-inq-obj-basename a-part))
		(setf besitzer (sd-inq-parent-obj 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 0.0 1.0 0.0) :source-space a-part :dest-space :global))
		(setf p6 (sd-vec-xform (gpnt3d 1.0 0.0 0.0) :source-space a-part :dest-space :global))
		(sd-call-cmds (progn
			(delete_3d a-part)
			(CREATE_MULTIPLE_PA :SHARE :owner besitzer :source orig :name name
				:match_three_pts p1 p2 p3 p4 p5 p6)
			))
	)
	(sd-call-cmds (delete_3d orig))
	)
);l-cp-ex
);local-functions
);sd-defdialog