View Single Post
  #8  
Old 08-17-2015, 11:09 PM
jkramer's Avatar
jkramer jkramer is offline
Registered User
 
Join Date: Oct 2002
Location: the Netherlands
Posts: 382
Re: Broken LISP in v18.1

Hi,

I made a "Rename All Shares" years ago, is this what you are looking for??
The field "Assembly" is the main assy in which you want to do your rename acgtion, "Part/Assy" is the part or assy that you want to rename. "Basename" is the new name for this Part/Assy. All shares of the Part/Assy will also be renamed.
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)
			)
		)
	)
)
Regards,
Jaap
Reply With Quote