Is it the same for this lisp?
Code:
;;--------------------------------------------------------------------------*
;; 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)
)
Thanks