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


(sd-defdialog 'rename-shared-parts

 :dialog-title "Change names of parts/assemblies"

 :toolbox-button t

 :variables '(

  (selection
   :title "Part Assembly"
   :selection (*sd-object-seltype*)
   :multiple-items t
   :prompt-text "Select part or assembly to rename."
   :initial-value nil)

  (custom-name
   :title "New name:"
   :value-type :string
   :initial-value nil)

  (contents-name
   :title "Contents name"
   :value-type :boolean
   :toggle-type :wide-toggle
   :initial-value nil)

  (one-level
   :title "One level"
   :value-type :boolean
   :toggle-type :wide-toggle
   :initial-value nil))

 :mutual-exclusion '(custom-name contents-name)
 :local-functions '(

  (next-action ()
   (let ()
    (dolist (child selection)
     (rename-to-base-or-custom-name child custom-name contents-name one-level)))))

 :ok-action '(sd-call-cmds (next-action))

 :help-action '(
  (display "Change names of Parts/Assemblies:")
  (display " ")
  (display "Changes name(s) of the specified parts and/or assemblies according")
  (display "to their contents name, if it exists or to a custom name.")
  (display " ")))



(defun rename-to-base-or-custom-name (part-assembly custom-name contents-name one-level)
  
 (when 
  (or
   (sd-inq-part-p part-assembly)
   (sd-inq-assembly-p part-assembly)
   (sd-inq-container-p part-assembly))

    (setq pathname (sd-inq-obj-pathname part-assembly))

    (when (sd-string/= pathname "/")
     (let (
      new-name
      (part-contents-name (sd-inq-obj-contents-name part-assembly)))

       (cond 
        (custom-name (setq new-name custom-name))
        ((and contents-name part-contents-name) (setq new-name part-contents-name))
        (t nil))

       (when new-name
        (let (
         new-name-incl-postfix
         (owner (sd-inq-parent-obj part-assembly)))

          (unless owner
           (setq owner (sd-pathname-to-obj "/")))

          (setq new-name-incl-postfix (add-name-postfix owner part-assembly new-name))

          (unless (sd-inq-obj-parent-contents-read-only-p part-assembly)
           (sd-call-cmds (change_name_pa :part_asmb pathname :name new-name-incl-postfix)))))
          
       (unless one-level
        (let ( 
         (children (sd-inq-obj-children part-assembly)))
         
         (dolist (child children)
          (rename-to-base-or-custom-name child custom-name contents-name one-level))))))))



(defun add-name-postfix (owner part-assembly name)
 (let (
  new-name
  basename
  (index 0)
  (basename-list (list))
  (child-list (sd-inq-obj-children owner)))

   (dolist (child child-list)
    (when 
     (or 
      (sd-inq-part-p child) 
      (sd-inq-assembly-p child) 
      (sd-inq-container-p child))

     (unless (equal child part-assembly)
      (setf basename (sd-inq-obj-basename child))
      (setf basename-list (nconc basename-list (list basename))))))

   (loop

    (incf index)

    (setq new-name (format nil "~a.~10,2,'0,'0r" name index))
    
    (unless (member new-name basename-list :test #'equal)
     (return t)))
    
    (values new-name)))