#1
|
|||
|
|||
Unshare all macro
Hello,
I am trying to create a lisp routine that removes all shares in a project. I found a "rename all shares" script here that uses SYSID to determine shares: www.cocreateusers.org/forum/showthread.php?t=8160 I was hoping to apply this code to copy and delete, instead of rename. Code:
(in-package :JAAPS_TOOLS) (use-package :OLI) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (sd-defdialog 'rename_all_shares :dialog-title "Rename All Shares" :toolbox-button t :variables '( (ASSY :value-type :assembly :modifies :nil :title "Assembly" :initial-value (sd-pathname-to-obj "/")) (PARTASSY :selection (*sd-part-seltype* *sd-assembly-seltype*) :title "Part/Assy" :modifies NIL) (basename :value-type :string :title "New Base Name" :initial-value NIL) ) :local-functions '( (doit () ;inquire sysid of the selected part/assy (setf sysid (sd-inq-obj-contents-sysid partassy)) ;get a list of all items below the assy (setf TOT (jb-inq-obj-tree-list assy)) ;process all these items (dolist (obj TOT "done") ;check if the current item is a share of the selected part/assy (if (equal (sd-inq-obj-contents-sysid obj) sysid) ;if so, rename it (progn ;(display (format nil "Found: ~a" (sd-inq-obj-pathname obj))) ;find the parent assy (if (sd-inq-parent-obj obj) (setf parntpath (sd-inq-obj-pathname (sd-inq-parent-obj obj))) (setf parntpath "")) ;create the name (setf pth (format nil "~a/~a" parntpath basename)) (setf suggestedpath pth) (setf countr 1) (setf basename2 basename) ;if the pathname already exists, we should add a postfix number (if (oli::sd-pathname-to-obj pth) (progn (setf goed 0) ;loop until we find a non-existing pathname (loop while (equal goed 0) do (setf pth (format nil "~a.~a" suggestedpath countr)) (if (oli::sd-pathname-to-obj pth) (progn (setf countr (+ countr 1)) ) (progn (setf goed 1) );progn );endif );endloop ;do the actual rename (setf basename2 (format nil "~a.~a" basename2 countr)) (change_name_pa :part_asmb obj :name basename2) );progn (change_name_pa :part_asmb obj :name basename) );endif );progn ());endif );dolist );doit ) :ok-action '(doit) ) (defun jb-inq-obj-tree-list (obj) (cons obj (apply #'nconc (mapcar #'jb-inq-obj-tree-list (sd-inq-obj-children obj) ) ) ) ) P |
Currently Active Users Viewing This Thread: 1 (0 members and 1 guests) | |
|
|