;; Richtet zwei Teile anhand ihrer lokalen Achsensysteme aus
;; Mai 2003, oet

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

(sd-defdialog 'gb_match_pa
:dialog-title (sd-multi-lang-string "align" :german "Ausrichten")
;;:toolbox-button nil
:variables '(
	(prt-list	:value-type :part-assembly
		:multiple-items t
		:initial-value nil
		:prompt-text (sd-multi-lang-string "Specify parts or assemblies to be moved" :german "Teile oder Baugruppen angeben, welche bewegt werden sollen")
		:title (sd-multi-lang-string "Part/Assy" :german "Teil/Baugr")
		:modifies nil
		:after-input (l-check-parents)
	)
	(ref	:value-type :part-assembly
		:multiple-items nil
		:initial-value nil
		:prompt-text (sd-multi-lang-string "Specify reference for part or assembly to be moved" :german "Referenz für Teil oder Baugruppe angeben, welches bewegt werden soll")
		:title (sd-multi-lang-string "reference" :german "Referenz")
		:modifies nil
	)
	(pb	:value-type :part-assembly
		:multiple-items nil
		:initial-value nil
		:prompt-text (sd-multi-lang-string "Specify fixed part or assembly" :german "feststehendes Teil oder Baugruppe angeben")
		:title (sd-multi-lang-string "target" :german "Ziel")
		:modifies nil
	)
	)
:ok-action '(l-ok)
:help-action '(sd-display-url (concatenate 'string "file:" (system:getenv "GBDOCDIR") "/doc/gb_match_pa.html#match"))
:cancel-action '()
:local-functions '(
(l-ok ()
	(let (
	(p1 (sd-vec-xform (gpnt3d 0.0 0.0 0.0) :source-space ref :dest-space :global))
	(p2 (sd-vec-xform (gpnt3d 0.0 0.0 0.0) :source-space pb :dest-space :global))
	(p3 (sd-vec-xform (gpnt3d 0.0 1.0 0.0) :source-space ref :dest-space :global))
	(p4 (sd-vec-xform (gpnt3d 0.0 1.0 0.0) :source-space pb :dest-space :global))
	(p5 (sd-vec-xform (gpnt3d 1.0 0.0 0.0) :source-space ref :dest-space :global))
	(p6 (sd-vec-xform (gpnt3d 1.0 0.0 0.0) :source-space pb :dest-space :global))
	)
	(dolist (pa prt-list)
		(sd-call-cmds (position_pa :part_assembly pa :match_three_pts p1 p2 p3 p4 p5 p6))
	)
	)
)

(l-check-parents ()
  (let (
  (t-list nil)
  )
  (mapcar #'(lambda (a-prt) (push (sd-inq-obj-parent-contents-read-only-p a-prt) t-list)) prt-list)
  (when (member t t-list)
        (progn
                (sd-display-error
                        (sd-multi-lang-string "Error: At least one owner is marked as read-only"
                        :german "Fehler: mindestens ein Besitzer ist schreibgeschuetzt"))
                (setf prt-list nil)
        )
  )
  )
)

) ;; local-functions

) ;; sd-defdialog