;;; ;;; ;;; Author: ;;; Henry C. Francis ;;; 425 N. Ashe St. ;;; Southern Pines, NC 28387 ;;; ;;; All rights reserved. ;;; ;;; Copyright: ;;; Edited: 7/6/2010 ;;;**************************************************************************** (DEFUN c:renumdwg () (SETQ fillst nil rnfillst nil fdatlst nil begfno_str NIL ) ;_ end of SETQ (IF ustr NIL (LOAD "ustr" "\nFile USTR.LSP not loaded! ") ) ;_ end of IF (WHILE (NOT (EQ (TYPE (READ (SETQ begfno_str (ustr 1 "New beginning number portion of filename" (IF fno_prefix fno_prefix nil ) ;_ end of if nil ) ;_ end of uint ) ;_ end of setq ) ;_ end of READ ) ;_ end of TYPE 'INT ) ;_ end of EQ ) ;_ end of NOT (PRINC "\nEnter the beginning file number as an integer (leading zeros OK) ") (PRINC) ) ;_ end of WHILE (SETQ begfno (READ begfno_str)) (SETQ incrfno 1) (IF pltlst (PROGN (SETQ fillst pltlst) (FOREACH n fillst (PROGN (SETQ thisfdat (DOS_SPLITPATH n) newname (CADDR thisfdat) ) ;_ end of SETQ (WHILE (WCMATCH (STRCASE newname) "[0-9]*") (SETQ newname (SUBSTR newname 2))) (COND ((< begfno 10) (SETQ fno_prefix (STRCAT "00" (ITOA begfno)) begfno (1+ begfno) ) ;_ end of SETQ ) ((< begfno 100) (SETQ fno_prefix (STRCAT "0" (ITOA begfno)) begfno (1+ begfno) ) ;_ end of SETQ ) (T (SETQ fno_prefix (STRCAT (ITOA begfno)) begfno (1+ begfno) ) ;_ end of SETQ ) ) ;_ end of COND (SETQ padlength (- (STRLEN begfno_str) (STRLEN fno_prefix))) (COND ((<= padlength 0) NIL) (= padlength 1 (SETQ fno_prefix (STRCAT "0" fno_prefix))) (= padlength 2 (SETQ fno_prefix (STRCAT "00" fno_prefix))) (= padlength 3 (SETQ fno_prefix (STRCAT "000" fno_prefix))) (= padlength 4 (SETQ fno_prefix (STRCAT "0000" fno_prefix))) (= padlength 5 (SETQ fno_prefix (STRCAT "00000" fno_prefix))) (= padlength 6 (SETQ fno_prefix (STRCAT "000000" fno_prefix))) (= padlength 7 (SETQ fno_prefix (STRCAT "0000000" fno_prefix))) (= padlength 8 (SETQ fno_prefix (STRCAT "00000000" fno_prefix))) (= padlength 9 (SETQ fno_prefix (STRCAT "000000000" fno_prefix))) (= padlength 10 (SETQ fno_prefix (STRCAT "0000000000" fno_prefix))) (= padlength 11 (SETQ fno_prefix (STRCAT "00000000000" fno_prefix))) (= padlength 12 (SETQ fno_prefix (STRCAT "000000000000" fno_prefix))) ) ;_ end of COND (SETQ newname (STRCAT (NTH 0 thisfdat) (NTH 1 thisfdat) fno_prefix newname (NTH 3 thisfdat))) (IF (OR (WCMATCH (STRCASE n) (STRCASE newname)) (MEMBER newname (MEMBER n fillst)) (MEMBER newname rnfillst) (FINDFILE newname) ) ;_ end of OR (COND ((WCMATCH (STRCASE n) (STRCASE newname)) (ALERT (STRCAT "The new name for \"" n "\" is unchanged!\nThe file will not be renamed!")) ) ((OR (MEMBER newname (MEMBER n fillst)) (MEMBER newname rnfillst) (FINDFILE newname)) (ALERT (STRCAT "The new name for \"" n "\" already exists!\nThe file will not be renamed!")) ) ) ;_ end of COND (PROGN (SETQ do_rename_it (DOS_MSGBOX (STRCAT "Rename\n" n "\nto\n" newname) "Confirm File Rename" 4 4)) (IF (EQ do_rename_it 6) (PROGN (IF (DOS_RENAME n newname) (PROGN (PRINC "\n") (PRINC n) (PRINC " renamed to ") (PRINC newname) (PRINC) (SETQ rnfillst (APPEND rnfillst (LIST newname))) ) ;_ end of PROGN (PROGN (PRINC "\n") (PRINC "Rename failed! ") (PRINC)) ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of progn ) ;_ end of foreach ) ;_ end of PROGN ) ;_ end of IF (PRINC) ) ;_ end of defun ;;;**************************************************************************** (DEFUN c:renamefile () (SETQ fillst nil rnfillst nil fdatlst nil begfno_str NIL ) ;_ end of SETQ (IF ustr NIL (LOAD "ustr" "\nFile USTR.LSP not loaded! ") ) ;_ end of IF (SETQ files_list (dos_getfilem "Select Files to Rename" (IF files_list (CAR files_list) (GETVAR "DWGPREFIX")) "All Files (*.*)|*.*||")) (SETQ fillst (MAPCAR '(LAMBDA (x) (STRCAT (CAR files_list) x)) (CDR files_list))) (SETQ rembegfn_str (ustr 1 "Beginning portion of existing filenames to remove if it exists? (~ for none, # for numbers)" (IF rembegfn_str rembegfn_str "~" ) ;_ end of if T ) ;_ end of uint ) ;_ end of setq (SETQ remendfn_str (ustr 1 "Ending portion of existing filenames to remove if it exists? (~ for none, # for numbers)" (IF remendfn_str remendfn_str "~" ) ;_ end of if T ) ;_ end of uint ) ;_ end of setq (SETQ begfn_str (ustr 1 "New beginning portion to add to filenames? (~ for none, # for numbers)" (IF begfn_str begfn_str "~" ) ;_ end of if T ) ;_ end of uint ) ;_ end of setq (SETQ endfn_str (ustr 1 "New ending portion to add to filenames? (~ for none, # for numbers)" (IF endfn_str endfn_str "~" ) ;_ end of if T ) ;_ end of uint ) ;_ end of setq (IF (AND files_list fillst) (PROGN (SETQ file_cnt 0) (FOREACH n fillst (PROGN (SETQ thisfdat (DOS_SPLITPATH n) newname (CADDR thisfdat) file_cnt (1+ file_cnt) ) ;_ end of SETQ (COND ((AND (EQ rembegfn_str "#")(WCMATCH (STRCASE newname) "#*")) (SETQ cnt 1) (WHILE (WCMATCH (SUBSTR newname cnt) "#*") (SETQ cnt (1+ cnt)) ) (SETQ newname (SUBSTR newname cnt))) ((AND (/= rembegfn_str "~")(WCMATCH (STRCASE newname) (STRCASE (STRCAT rembegfn_str "*")))) (SETQ newname (SUBSTR newname (1+(STRLEN rembegfn_str))))) (T (SETQ newname (NTH 2 thisfdat))) ) (COND ((AND (EQ remendfn_str "#")(WCMATCH (STRCASE newname) "*#")) (SETQ cnt (STRLEN newname)) (WHILE (WCMATCH (SUBSTR newname 1 cnt) "*#") (SETQ cnt (1- cnt)) ) (SETQ newname (SUBSTR newname cnt))) ((AND (/= remendfn_str "~")(WCMATCH (STRCASE newname) (STRCASE (STRCAT "*" remendfn_str)))) (SETQ newname (SUBSTR newname 1 (-(STRLEN newname)(STRLEN remendfn_str))))) ) (SETQ newpathname (STRCAT (NTH 0 thisfdat) (NTH 1 thisfdat) (IF (EQ begfn_str "~") "" (IF (EQ begfn_str "#")(STRCAT(ITOA file_cnt)"_") begfn_str)) newname (IF (EQ endfn_str "~") "" (IF (EQ endfn_str "#")(STRCAT "_"(ITOA file_cnt)) endfn_str))(NTH 3 thisfdat))) (IF (OR (WCMATCH (STRCASE n) (STRCASE newpathname)) (MEMBER newpathname fillst) (MEMBER newpathname rnfillst) (FINDFILE newpathname) ) ;_ end of OR (COND ((WCMATCH (STRCASE n) (STRCASE newpathname)) (ALERT (STRCAT "The new name for \"" n "\" is unchanged!\nThe file will not be renamed!")) ) ((OR (MEMBER newpathname fillst) (MEMBER newpathname rnfillst) (FINDFILE newpathname)) (ALERT (STRCAT "The new name \"" newpathname "\" for\n\"" n "\" already exists!\nThe file will not be renamed!")) ) ) ;_ end of COND (PROGN (SETQ do_rename_it (DOS_MSGBOX (STRCAT "Rename\n" n "\nto\n" newpathname) "Confirm File Rename" 4 4)) (IF (EQ do_rename_it 6) (PROGN (IF (DOS_RENAME n newpathname) (PROGN (PRINC "\n") (PRINC n) (PRINC " renamed to ") (PRINC newpathname) (PRINC) (SETQ rnfillst (APPEND rnfillst (LIST newpathname))) ) ;_ end of PROGN (PROGN (PRINC "\n") (PRINC "Rename failed! ") (PRINC)) ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of progn ) ;_ end of foreach ) ;_ end of PROGN (ALERT "No files were selected!") ) ;_ end of IF (PRINC) ) ;_ end of defun ;|«Visual LISP© Format Options» (120 2 15 2 T "end of " 100 9 2 0 nil nil nil T T) ;*** DO NOT add text below the comment! ***|;