Duplayout LISP

Hello,

i've been useing Duplayout LISP made by Gile for a while (CADtutor forum), however i'm missing 2 things in it, and I hope you can guys help me out:

When using duplayout, the name of the new layouts are set to the last character with string 1. (i.e. layout name: 4-25, copy x3, new layout names: 4-26, 4-27, 4-28), I already found in the script where change the string from 1 to X (i.e. layout name 4-25, copy x3, string - 12, new layout names: 4-37, 4-49, 4-61). It would be nice if it would ask for the string value with base 1 (just like it does for layout to duplicate, and the number of copies).

The second problem is to make change/name after the 1st character (i.e. layout name 4-25, copy x3, new layout names: 5-25, 6-25, 7-25). It could also ask for the character to name after (with base last). It's not often to have more than 3 characters to change, so it could ask for First, Last, Middle or something like that. If it's to hard it can only ask for First, and Last

Thanks for the help.

(defun c:duplayout ( /
                   increment_string CustSort CustSort_Comparable CustSort_SplitStr
                   oce louts flag ctab layout# layoutname newlayoutname )
 
 (vl-load-com)
 ;;******************************************************************
 ;; Local Functions
 ;;******************************************************************
 (defun increment_string (string inc / num tmp1 len check sign)
   (if (/= string "");Don't process an empty string
     (progn
       (setq num ""
             tmp1 1
             )
       (while (and (> (setq len (strlen string)) 0) tmp1)
         (setq check (substr string len));The last character of the string
         (if (wcmatch check "[0-9]");Is it a number?
           (setq num (strcat check num);If yes put it aside
                 string (substr string 1 (1- len));and take it off the original string
                 )
           (setq tmp1 nil);If no end the loop
           );if
         );while
       
       ;check for negative signage in front of the string
       (if (and (> (strlen string) 0) (= (substr string 1 1) "-"))
         (progn
           (setq sign -1)
           (if (> (strlen string) 1);more than just a negative sign
             (setq string (vl-string-left-trim " " (substr string 2 (1- (strlen string)))));remove the negative sign and any spaces
             (setq string "")
             )
           );progn
         (setq sign 1)
         )
       
       
       
       (setq tmp1 (+ (* (atoi num) sign) inc)
             sign (if (< tmp1 0) "-" "")
             tmp1 (itoa (abs tmp1))
             )
       
       ;Then pad with zeros if the original was padded
       (if (< (strlen tmp1) (strlen num))
         (repeat (- (strlen num) (strlen tmp1)) (setq tmp1 (strcat "0" tmp1)));Buffer with zeros
         )
       (strcat sign string tmp1)
       );progn
     "1"
     );if
   )
 
 ;;******************************************************************
 ;;Customised string sorting function Main Part
 (defun CustSort ( x )
   (vl-sort x (function (lambda ( x1 x2 / n1 n2 comp )
                          (setq x1 (CustSort_SplitStr x1);creates a broken down list of alpha & numeric values from the string
                                x2 (CustSort_SplitStr x2);creates a broken down list of alpha & numeric values from the string
                                )
                          (while
                            (and
                              (setq comp (CustSort_Comparable (setq n1 (car x1)) (setq n2 (car x2))))
                              (= n1 n2)
                              (/= n1 nil)
                              )
                            (setq x1 (cdr x1) x2 (cdr x2))
                            );while
                          (if comp (< n1 n2) (numberp n1))
                          );lambda
                        );function
            );vl-sort
   )
 
 ;*********************************************************************
 ;;Customised string sorting function Sub Part 1 - Tests whether the values are both strings or both numbers
 (defun CustSort_Comparable ( e1 e2 )
   (or
     (and (numberp e1) (numberp e2))
     (= 'STR (type e1) (type e2))
     (not e1)
     (not e2)
     )
   )
 
 ;*********************************************************************
 ;;Customised string sorting function Sub Part 2 - Splits a string into a list of separated string and number parts
 (defun CustSort_SplitStr ( str / lst test rslt num tmp )
   (setq lst  (vl-string->list str)
         test (chr (car lst))
         )
   (if (< 47 (car lst) 58) (setq num T))
   (while (setq lst (cdr lst))
     (if num
       (cond
         ((= 46 (car lst))
          (if (and (cadr lst) (setq tmp (strcat "0." (chr (cadr lst)))) (numberp (read tmp)))
            (setq rslt (cons (read test) rslt) test tmp lst (cdr lst))
            (setq rslt (cons (read test) rslt) test "." num nil))
          );1st condition
         ((< 47 (car lst) 58)
          (setq test (strcat test (chr (car lst))))
          );2nd condition
         (T (setq rslt (cons (read test) rslt)
                  test (chr (car lst))
                  num  nil
                  )
          );3rd condition
         );cond
       (if (< 47 (car lst) 58)
         (setq rslt (cons test rslt) test (chr (car lst)) num T)
         (setq test (strcat test (chr (car lst)))));if
       );if
     );while
   (if num (setq rslt (cons (read test) rslt)) (setq rslt (cons test rslt)))
   (reverse rslt)
   )
 
 ;;******************************************************************
 ;; Main Program Code
 ;;******************************************************************
 
 (setq oce (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 
 (setq louts (layoutlist)
       ctab (if (= "Model" (getvar "ctab")) (car louts) (getvar "ctab"))
       flag nil
       )
 
 (while (not flag)
   (setq layoutname (getstring T (strcat "\nLayout to duplicate <" ctab ">: ")))
   (if (= layoutname "") (setq layoutname ctab))
   (if (= layoutname "Model")
     (alert "Cannot duplicate Modelspace")
     (if (member (strcase layoutname) (mapcar 'strcase louts)) (setq flag T))
     );if
   );while
 
 (initget 6)
 (setq layout# (getint "\nHow many copies ? <2>: "))
 (if (null layout#) (setq layout# 2))
 
 (setq newlayoutname layoutname
       louts (mapcar 'strcase louts)
       )
 
 (repeat layout#
   (while (member (strcase (setq newlayoutname (increment_string newlayoutname 1))) louts))
   (vl-cmdf ".layout" "copy" layoutname newlayoutname)
   (setq louts (cons (strcase newlayoutname) louts))
   );repeat
 
 (setq louts (CustSort louts))
 (vlax-for tab (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
   (if (not (= (strcase (vla-get-name tab)) "MODEL"))
     (vla-put-taborder tab (1+ (vl-position (strcase (vla-get-name tab)) louts)))
     )
   )
 
 (setvar "cmdecho" oce)
 (princ)
 );defun

Bloodhurt,

I use a mixture of the following, you may want to explore these:

Rename on Steroids:

http://www.cadforum.cz/cadforum_en/rename-on-steroids-complex-renaming-of-autocad-objects-tip9265

Post #16 here (Requires AUGI login and AutoCAD VBA Enabler Installed):

http://forums.augi.com/showthread.php?17630-Automatically-renumber-layout-tabs/page2

Tabsort:

http://www.lee-mac.com/tabsort.html

Cheers,

@abra-CAD-abra

Thanks for reply I have these lisps, and sometimes I use them, however right now I have to many layouts to copy to use them so I was searching for some easier, and FASTER way ;] Right now I would have around 120-150 layouts to copy :/