View Single Post
  #10  
Old 07-10-2018, 01:21 PM
Kaji Kaji is offline
Registered User
 
Join Date: Mar 2006
Posts: 19
Re: Broken LISP in v18.1

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
Reply With Quote