;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
;;;; Developer Notes
;;;;
;;;;     This function is the cobination of both of the functions found here ->  http://osd.cad.de/lisp_3d_40.htm
;;;; In addition, this new function includes the following upgrades
;;;;   1. Includes an optional X Y Z orientation for both objects in the exchange
;;;;   2. Includes an undo function
;;;;   3. Provides either exchange all or exchange selected objects
;;;;
;;;; Version 3.2
;;;; Date    August 25, 2015
;;;; Developer - Chris Palmer
;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
(in-package     :custom)
(use-package    :oli)





;;;; ===================================================================================================================
(sd-defdialog 'sd_utility_advance_part_exchanger
;;;; ===================================================================================================================
    :dialog-title   "Parts Exchanger"
    ;:website        http://osd.cad.de/lisp_3d_40.htm <-Reference
    :variables '(
        (UndoStatus :initial-value nil)
        (Owner
            :value-type :assembly
            :initial-value (sd-pathname-to-obj "/")
            :modifies :contents
            :toggle-type :invisible)
        ("Selection")
            (flag0
                :title "Enable Directional Refs?"
                :expand-shrink-toggle-type :boolean
                :expand-shrink ((SourcePart Pnt1a Pnt2a Pnt3a Destination Pnt1b Pnt2b Pnt3b)
                                (SourcePart Destination) )
                :initial-value nil
                :after-input (cond
                    ((equal flag0 nil)(sd-set-variable-status 'ExecuteAll :enable T))
                    ((equal flag0 t)  (sd-set-variable-status 'ExecuteAll :enable nil)) );cond
                :toggle-type :wide-toggle)
            (SourcePart
                :title "New Part"
                :value-type :part-assembly
                :size :third
                :initial-value nil
                :multiple-items nil
                :prompt-text "Specify new part or assembly to be used"
                :modifies nil
                :next-variable 'Destination
                :before-input (setq Destination nil)
                :after-input  (setq pnt_1a (sd-vec-xform (gpnt3d 0.0 0.0 0.0) :source-space SourcePart :dest-space :global)
                                    pnt_2a (sd-vec-xform (gpnt3d 1.0 0.0 0.0) :source-space SourcePart :dest-space :global)
                                    pnt_3a (sd-vec-xform (gpnt3d 0.0 1.0 0.0) :source-space SourcePart :dest-space :global) ) )
            (Pnt1a
                :title "Origin Point"
                :value-type :point-3d
                :enable nil
                :prompt-text "Pick the starting point"
                :next-variable 'Pnt2a
                :after-input (after-Pnt1a-action) )
            (Pnt2a
                :title "Ref. Dir 1a"
                :value-type :measure-direction
                :enable nil
                :prompt-text "Select the original part reference direction"
                :initial-direction-negative t
                :built-in-feedback nil
                :next-variable 'Pnt3a
                :after-input (after-Pnt2a-action) )
            (Pnt3a
                :title "Ref. Dir 2a"
                :value-type :measure-direction
                :enable nil
                :prompt-text "Select the orignal part second refence direciton"
                :initial-direction-negative nil
                :built-in-feedback nil
                :next-variable 'OldPart
                :after-input (progn (after-Pnt3a-action) (setq Pnt3b)))
            (ExchangeLoop :value-type :boolean :toggle-type :invisible :initial-value nil)
            (Destination
                :title "Old Part"
                :value-type :part-assembly
                :size :third
                :initial-value nil
                :multiple-items nil
                :prompt-text "Specify part or assembly to be replaced" 
                :modifies nil
                :after-input  (progn
                    (CheckPart Destination)
                    (setq Owner     (sd-inq-parent-obj Destination)
                          pnt_1b    (sd-vec-xform (gpnt3d 0.0 0.0 0.0) :source-space Destination :dest-space :global)
                          pnt_2b    (sd-vec-xform (gpnt3d 1.0 0.0 0.0) :source-space Destination :dest-space :global)
                          pnt_3b    (sd-vec-xform (gpnt3d 0.0 1.0 0.0) :source-space Destination :dest-space :global) 
                      );setq
                    (cond
                        ((equal flag0 T)  (sd-put-buffer ":Pnt1b"))
                        ((equal flag0 nil)(cond((equal ExchangeLoop t)(sd-put-buffer ":ExecuteFew")) ))
                      );cond
                  );progn
              );Destination
            (Pnt1b
                :title "Destination"
                :value-type :point-3d
                :enable nil
                :multiple-items t
                :show-select-menu t
                :prompt-text "Pick the Destination point"
                :next-variable (cond
                    ((equal ExchangeLoop nil) Pnt2b)
                    ((equal Pnt2b nil) Pnt2b)
                    (t (sd-put-buffer ":ExecuteFew"))
                  );cond
                :after-input (after-Pnt1b-action) )
            (Pnt2b
                :title "Ref. Dir 1b"
                :value-type :measure-direction
                :enable nil
                :prompt-text "Select Main Reference Direction"
                :initial-direction-negative t
                :built-in-feedback nil
                :next-variable 'Pnt3b
                :after-input (after-Pnt2b-action) )
            (Pnt3b
                :title "Ref. Dir 2b"
                :value-type :measure-direction
                :enable nil
                :prompt-text "Second Reference Direction"
                :initial-direction-negative nil
                :built-in-feedback nil
                :after-input (after-Pnt3b-action) )
        ("Exchange Options")
            (flag1
                :title "Delete Source?"
                :value-type :boolean
                :initial-value t
                :toggle-type :wide-toggle)
            (flag2
                :title "Keep Old Name?"
                :value-type :boolean
                :initial-value nil 
                :toggle-type :wide-toggle)
        ("How many are we exchanging?")
            (ExecuteAll
                :title "Exchange  All  Parts"
                :toggle-type  :wide-toggle
                :push-action  (progn
                    (print "============================================================")
                    (print "======== Exchanging All of old Parts =======================")
                    (print "============================================================")
                    (setq ExchangeLoop nil)
                    (ExChangeAll Owner)
                  );progn 
              );ExchangeAll
            (ExecuteFew
                :title "Exchange  Selected  Parts"
                :toggle-type  :wide-toggle
                :push-action  (progn
                    (print "============================================================")
                    (print "======= Exchanging Some of the old Parts ===================")
                    (print "============================================================")
                    (setq  ExchangeLoop T)
                    (cond
                        ((equal flag0 nil)(ExChangeFew1 SourcePart Destination) )
                        ((equal flag0 T)  (ExChangeFew2 SourcePart Destination) )
                    );cond
                  );progn 
                :next-variable 'Destination)
            (back
                :title "  Undo"
                :size :third
                :initial-enable NIL
                :push-action  (UndoExchange) );back  
        ;;Invisible Variables
            (obj2 :title "Base Number" :value-type :display-only :toggle-type :invisible)
            (SetContainer :value-type :boolean :toggle-type :invisible :initial-value t)
            (Pnt_1a :value-type :point-3d :incl-position :3d :toggle-type :invisible)
            (Pnt_1b :value-type :point-3d :incl-position :3d :toggle-type :invisible)
            (Pnt_2a :value-type :point-3d :incl-position :3d :toggle-type :invisible)
            (Pnt_2b :value-type :point-3d :incl-position :3d :toggle-type :invisible)
            (Pnt_3a :value-type :point-3d :incl-position :3d :toggle-type :invisible)
            (Pnt_3b :value-type :point-3d :incl-position :3d :toggle-type :invisible)
            (Pnt2a-fback :initial-value nil)
            (Pnt3a-fback :initial-value nil)
            (Pnt2b-fback :initial-value nil)
            (Pnt3b-fback :initial-value nil)
            (back-states :initial-value (list (list (sd-set-model-checkpoint) nil nil nil nil nil nil nil nil nil nil)))
      );variables
    :local-functions '(
      ;;Check the Old part for issuses
        (CheckPart (obj)
            (when (equal SourcePart obj)
                (sd-display-alert "These parts are the same"))
            (when (sd-inq-obj-parent-contents-read-only-p obj)
                (sd-display-alert "The Parent container is Read-only") );when
            (when (sd-inq-obj-contents-read-only-p obj)
                (sd-display-alert (format nil "The Part ~A is Read-only" obj)))
          );PartCheckList
      ;;Setup the undo function
        (UndoExchange ()
            (when UndoStatus
                (let
                    ((state (pop UndoStatus)))
                    ;(end-dir-fback)
                    (sd-return-to-model-checkpoint (first state) )
                    (setq Destination (second state) );setq 
                  );let
                (unless UndoStatus
                    (sd-set-variable-status 'back :enable nil)
                  );unless
              );when
            (sd-put-buffer ":Destination")
          );UndoExchange
      ;;Setup NewPart's Point System
        (start-Pnt2a-fback ()
          (let ()
              (when (and Pnt1a (nth 0 Pnt2a))
                  (setq Pnt2a-fback  (sd-start-direction-feedback
                                            :point Pnt1a
                                            :direction (nth 0 Pnt2a)
                                            :disc t
                                            :color 0,1,0) ) ) ) 
          );start-Pnt2a-fback
        (after-Pnt2a-action ()
            (let ()
                (sd-end-feedback Pnt2a-fback)
                (sd-end-feedback Pnt3a-fback)
                (when Pnt3a
                    (when (sd-vec-colinear-p (nth 0 Pnt2a) (nth 0 Pnt3a))
                        (progn
                            (setf Pnt3a nil)
                            (sd-display-error "Main and second direction are the same")
                          );;progn
                      );;when
                  );;when
                (start-Pnt2a-fback)
                (start-Pnt3a-fback)
              );;let
          );after-Pnt2a-action
        (start-Pnt3a-fback ()
            (let (fbvec)
                (when (and Pnt1a (nth 0 Pnt2a) (nth 0 Pnt3a))
                    (progn
                        (setf fbvec (sd-vec-cross-product (sd-vec-cross-product (nth 0 Pnt2a) (nth 0 Pnt3a)) (nth 0 Pnt2a)))
                        (setq Pnt3a-fback (sd-start-direction-feedback
                                         :point Pnt1a
                                         :direction fbvec
                                         :disc nil
                                         :color 0,0.5,0) )
                      );;progn
                  );;when
              );;let
          );start-Pnt3a-fback
        (after-Pnt3a-action ()
            (let ()
                (sd-end-feedback Pnt3a-fback)
                (when (and Pnt2a Pnt3a)
                    (if (sd-vec-colinear-p (nth 0 Pnt2a) (nth 0 Pnt3a))
                        (progn
                             (setf Pnt3a nil)
                             (sd-display-error "Main and second direction are the same")
                          );;progn
                      );;if
                    (start-Pnt3a-fback)
                  );;when
              );;let
          );after-Pnt3a-action
        (after-Pnt1a-action ()
            (let ()
                (sd-end-feedback Pnt2a-fback)
                (start-Pnt2a-fback)
                (sd-end-feedback Pnt3a-fback)
                (start-Pnt3a-fback)
              );;let
          );after-Pnt1a-action
      ;;Setup OldPart's Point System
        (start-Pnt2b-fback ()
            (let (origin)
                (cond
                    (Pnt1b (setf origin Pnt1b) )
                    ((nth 4 (first back-states))
                        (setf origin (nth 4 (first back-states))) )
                    (Pnt1a (setf origin Pnt1a) )
                    (t setf origin nil)
                  );;cond
                (when (and origin (nth 0 Pnt2b))
                      (setq Pnt2b-fback (sd-start-direction-feedback
                                          :point origin
                                          :direction (nth 0 Pnt2b)
                                          :disc t
                                          :color 1,0,0) )
                  );;when
              );;let
          );start-Pnt2b-fback
        (after-Pnt2b-action ()
            (let ()
                (sd-end-feedback Pnt2b-fback)
                (sd-end-feedback Pnt3b-fback)
                (when Pnt3b
                    (when (sd-vec-colinear-p (nth 0 Pnt2b) (nth 0 Pnt3b))
                        (progn
                            (setf Pnt3b nil)
                            (sd-display-error "Main and second direction are the same")
                            (sd-put-buffer ":Pnt3b")
                          );;progn
                      );;when
                  );;when
                (start-Pnt2b-fback)
                (start-Pnt3b-fback)
              );;let
          );after-Pnt2b-action
        (start-Pnt3b-fback ()
            (let (origin)
                (cond
                    (Pnt1b  (setf origin Pnt1b) )
                    ((nth 4 (first back-states))
                            (setf origin (nth 4 (first back-states))) )
                    (Pnt1a (setf origin Pnt1a) )
                    (t setf origin nil)
                  );;cond
                (when (and Pnt1a (nth 0 Pnt2b) (nth 0 Pnt3b))
                    (progn
                        (setf fbvec (sd-vec-cross-product (sd-vec-cross-product (nth 0 Pnt2b) (nth 0 Pnt3b)) (nth 0 Pnt2b)))
                        (setq Pnt3b-fback (sd-start-direction-feedback
                                                 :point origin
                                                 :direction fbvec
                                                 :disc nil
                                                 :color 0.5,0,0 ) )
                      );;progn
                  );;when
              );;let
          );start-Pnt3b-fback
        (after-Pnt3b-action ()
            (let ()
                (sd-end-feedback Pnt3b-fback)
                (when (and Pnt2b Pnt3b)
                    (if (sd-vec-colinear-p (nth 0 Pnt2b) (nth 0 Pnt3b))
                        (progn
                            (setf Pnt3b nil)
                            (sd-display-error "Main and second direction are the same")
                          );;progn
                      );;if
                    (start-Pnt3b-fback)
                  );;when
              );;let
          );after-Pnt3b-action
        (after-Pnt1b-action ()
            (let ()
                (sd-end-feedback Pnt2b-fback)
                (start-Pnt2b-fback)
                (sd-end-feedback Pnt3b-fback)
                (start-Pnt3b-fback)
              );;let
          );after-Pnt3b-action
      ;;Exchange All the old parts
        (ExChangeAll (obj)
            (progn
              ;;Setup variables, just as ...
                (setf
                    PartName  (cond  ((equal flag1 t)  (first (sd-string-split (sd-inq-obj-basename Destination) ".") ))
                                     ((equal flag1 nil)(first (sd-string-split (sd-inq-obj-basename SourcePart) ".") )) );cond
                    NameString (sd-gen-obj-basename :part :parent Owner :prefix (format nil "~A." PartName))
                  );setf
              ;;Go Through each object
                (dolist (child (sd-inq-obj-children obj))
                    (if SetContainer
                        (ExChangeAll child) ;;THEN - want everything  
                        ;;ELSE - don't want what's in the containers
                        (if (not (sd-inq-container-p child))
                            (ExChangeAll child) ) ) );; end dolist
              ;;Search by Part Number
                (when (sd-inq-part-p obj) 
                    ;;Break down the part string i.e. 2-234000.1.1 -> 2-234000
                        (setq   Sel_Part_Base (first (sd-string-split (sd-inq-obj-basename Destination) ".") )
                                obj2 (first (sd-string-split (sd-inq-obj-basename obj) ".") )
                          );setq
                    ;;Check the part string length first 
                        (cond
                          ;;If the part string length does match
                            ((equal (length obj2) (length Sel_Part_Base) )
                              ;;Check if the part string matches the base number  
                                (cond
                                  ;;If the Part Numbers match
                                    ((equal obj2 Sel_Part_Base)
                                        (progn
                                            (setq 
                                                pnt_1b (sd-vec-xform (gpnt3d 0.0 0.0 0.0) :source-space obj :dest-space :global)
                                                pnt_2b (sd-vec-xform (gpnt3d 1.0 0.0 0.0) :source-space obj :dest-space :global)
                                                pnt_3b (sd-vec-xform (gpnt3d 0.0 1.0 0.0) :source-space obj :dest-space :global) 
                                              );setq
                                          ;;Place the new part over the old part  
                                            (sd-call-cmds
                                                (create_multiple_pa
                                                    :share
                                                    :name  NameString
                                                    :owner (sd-inq-parent-obj obj)
                                                    :source SourcePart
                                                    ;:keep_attr (cond ((equal flag3 t) :on) (t :off))
                                                    :match_three_pts pnt_1a pnt_1b pnt_2a pnt_2b pnt_3a pnt_3b)
                                                :success (print (format nil "++++ New Part Created - ~A" NameString))
                                                :failure (print (format nil "---- Duplicate name created - ~A." NameString))
                                              )
                                          ;;Delete the old part
                                            (sd-call-cmds (delete_3d obj))
                                      ))
                                  );cond
                              );=length
                          );cond
                  );when
              );progn
          );ExchangeAll
      ;;Exchange the Selected Part (2)
        (ExChangeFew1 (NewPart OldPart);Uses No Directions
            (progn
               ;;Enable the Back/undo button
                (sd-set-variable-status 'back :enable T)
                (push (list (sd-set-model-checkpoint) OldPart) UndoStatus)
              ;;Setup variables, just as ...
                (setf
                    PartName  (cond  ((equal flag2 t)  (first (sd-string-split (sd-inq-obj-basename OldPart) ".") ))
                                     ((equal flag2 nil)(first (sd-string-split (sd-inq-obj-basename NewPart) ".") )) );cond
                    NameString    (sd-gen-obj-basename :part :parent Owner :prefix (format nil "~A." PartName))
                  );setf
                (setq
                    PreviousState (sd-set-model-checkpoint)
                    pnt_1b (sd-vec-xform (gpnt3d 0.0 0.0 0.0) :source-space OldPart :dest-space :global)
                    pnt_2b (sd-vec-xform (gpnt3d 1.0 0.0 0.0) :source-space OldPart :dest-space :global)
                    pnt_3b (sd-vec-xform (gpnt3d 0.0 1.0 0.0) :source-space OldPart :dest-space :global) 
                  );setq
              ;;Copy Part, Exchange it, and reset loop  
                  (sd-call-cmds
                      (create_multiple_pa
                          :share
                          :name   NameString
                          :owner  Owner
                          :source NewPart
                          ;:keep_attr (cond ((equal flag3 t) :on) (t :off))
                          :match_three_pts pnt_1a pnt_1b pnt_2a pnt_2b pnt_3a pnt_3b) 
                      :success (print (format nil "++++ New Part Created - ~A" NameString))
                      :failure (print (format nil "---- Duplicate name created - ~A." NameString))
                    );sd-call-cmds
              ;;Delete the old part
                (sd-call-cmds (delete_3d OldPart))
              ;;Reset Destination
                (setq Destination nil)
              );progn
          );ExChangeFew1
        (ExChangeFew2 (NewPart OldPart);Uses Directions
            (progn
               ;;Enable the Back/undo button
                (sd-set-variable-status 'back :enable T)
                (push (list (sd-set-model-checkpoint) OldPart) UndoStatus)
              ;;Setup variables, just as ...
                (setf 
                      PartName  (cond  ((equal flag2 t)  (first (sd-string-split (sd-inq-obj-basename OldPart) ".") ))
                                       ((equal flag2 nil)(first (sd-string-split (sd-inq-obj-basename NewPart) ".") )) );cond
                      NameString    (sd-gen-obj-basename :part :parent Owner :prefix (format nil "~A." PartName))
                  );setf
                (setq
                    PreviousState (sd-set-model-checkpoint)
                    Pnt_2a (sd-vec-add Pnt1a (first Pnt2a))
                    Pnt_2b (sd-vec-add Pnt1b (first Pnt2b))
                    Pnt_3a (sd-vec-add Pnt1a (first Pnt3a))
                    Pnt_3b (sd-vec-add Pnt1b (first Pnt3b)) 
                  );setq
              ;;Copy Part, Exchange it, and reset loop  
                (sd-call-cmds
                    (create_multiple_pa
                        :share
                        :name   NameString
                        :owner  Owner
                        :source NewPart
                        ;:keep_attr (cond ((equal flag3 t) :on) (t :off))
                        :match_three_pts Pnt1a Pnt1b Pnt_2a Pnt_2b Pnt_3a Pnt_3b)
                    :success (print (format nil "++++ New Part Created - ~A" NameString))
                    :failure (print (format nil "---- Duplicate name created - ~A." NameString))
                  );sd-call-cmds
              ;;Delete the old part
                (sd-call-cmds (delete_3d OldPart))
              ;;Reset Destination
                (setq Destination nil  Pnt1b   nil)
              );progn
          );ExChangeFew2
      ;;Cleanup the feedbacks
        (cleanup ()
            (sd-end-feedback Pnt2a-fback)
            (sd-end-feedback Pnt3a-fback)
            (sd-end-feedback Pnt2b-fback)
            (sd-end-feedback Pnt3b-fback)
            (add_to_vp_drawlist (oli::sd-inq-current-vp) :with-wp :no-hilite :container-propagate-cmd :stock-container-propagate-cmd SourcePart)
          );cleanup
      );local-functions
    :cleanup-action '(progn
                        (cleanup)
                        (cond ((equal flag1 T)(sd-call-cmds(delete_3d SourcePart)))))
  );sd-defdialog