;;--------------------------------------------------------------------------* ;; Copyright 2013 IWG * ;; * ;;--------------------------------------------------------------------------* (in-package :custom) (use-package :OLI) ;;--------------------------------------------------------------------------* (sd-defdialog 'iwg-teil-mehrfach-eigenstaendig-dialog :dialog-title "Mehrfach Eigenstaendig" ;;:dialog-control :sequential :precondition '(if (sd-inq-active-configuration) (values :error "Achtung, Konfiguration aktiv!") :ok) :variables '( ;;local (good) ;;dialog (teil :selection (*sd-object-seltype*) :multiple-items t :show-select-menu t :incremental-selection t ;;:on-non-empty-list :modifies :parent-contents :prompt-text "Teile oder Baugruppen angeben" :title "Teil/Bgr" :after-input (check-it) ) (ol :value-type :boolean :toggle-type :wide-toggle :title "Eine Ebene" :initial-value t ) (next :push-action (sd-call-cmds (next-action)) ) ) :local-functions '( (check-it () (let (good primus exlist sel exlist primus restlist) (setf good t) (setf primus (car teil)) (setf restlist (cdr teil)) (setf exlist (sd-inq-obj-shared-objects primus :all t)) (dolist (sel restlist) (when (not (find sel exlist :test #'equal)) (setf good nil) );;when );;dolist (when (not good) (progn (sd-display-error "Nicht alle ausgewaehlten Teile sind Exemplare voneinander!") (setf teil nil) );;progn );;when );;let ) (next-action () (let (olus primus exlist sel exlist primus et restlist por pz px lor lz lx bgr assy prt altname) (if ol (setf olus :on) (setf olus :off)) (setf primus (car teil)) (setf restlist (cdr teil)) (setf exlist (sd-inq-obj-shared-objects primus :all t)) (setf por (sd-vec-xform (make-gpnt3d :x 0 :y 0 :z 0) :source-space primus :dest-space :global)) (setf pz (sd-vec-xform (make-gpnt3d :x 0 :y 0 :z 1) :source-space primus :dest-space :global)) (setf px (sd-vec-xform (make-gpnt3d :x 1 :y 0 :z 0) :source-space primus :dest-space :global)) (setf bgr (sd-inq-parent-obj primus)) (if bgr (setf assy (sd-inq-obj-pathname bgr)) (setf assy "/") );;if (setf prt (sd-inq-obj-pathname primus)) (sd-call-cmds (pa_unshare :source prt :onelevel olus)) (setf vari (sd-pathname-to-obj prt)) (dolist (et restlist) (setf lor (sd-vec-xform (make-gpnt3d :x 0 :y 0 :z 0) :source-space et :dest-space :global)) (setf lz (sd-vec-xform (make-gpnt3d :x 0 :y 0 :z 1) :source-space et :dest-space :global)) (setf lx (sd-vec-xform (make-gpnt3d :x 1 :y 0 :z 0) :source-space et :dest-space :global)) (setf altname (sd-inq-obj-basename et)) (setf bgr (sd-inq-parent-obj et)) (setf assy (sd-inq-obj-pathname bgr)) (delete_3d (sd-inq-obj-pathname et)) (sd-call-cmds (create_multiple_pa :share :owner assy :name altname :source prt :keep_attr :on :match_three_pts por lor px lx pz lz ) ) );;dolist );;let ) ) :ok-action '(next-action) )