Lisp routine needed

Does anyone have / know of a lisp that will create layers with similar
names through prompts and set layer color based on the user input?
Example: need layers E30_733, E30_734, E30_735, E31_733, E31_734, etc.
the lisp could prompt for layer prefix "E30" then automatically insert
the underscore then prompt for layer suffix "733" and then based on the
second input automatically assign the color 145 based on the '733'
input. Also, since the prefix doesnt change as often, lisp would
default to previous input until new input is received. Even something
similar that i can edit would be great. thanks very, very much.

 

hi, mate,
try my lisp routine below:


;;; CreatLayers.LSP
;;; 18 MARCH 2006
;;; C:CRLA
;;; Creat a new set of layers with a common prifix
;;;---------------------------------------------------------------------
;;;
;;;
(DEFUN C:CRLA (/ NSN SS SSLEN I
ENT ELIST NELIST NEW_LAYER_NAME
LDATA NLDATA LA_FLAG
)

;; get prifix - NSNAME
(IF NSNAME
(PROGN ; IF NSNAME EXISTING
(PRINC (STRCAT "\nEnter new layer prefix <" NSNAME ">: "))
(IF
(/= (SETQ NSN (GETSTRING))
""
)
(SETQ NSNAME NSN)
)
)
(IF ; IF NSNAME NOT EXISTING
(= (SETQ NSNAME (GETSTRING "\nEnter new layer prefix <NEW>: "))

""
)
(SETQ NSNAME "NEW")
)
) ;_END-IF-NSNAME
;;
;; get color of the layer set - LSCOLOR
(IF LSCOLOR
(PROGN ; IF LSCOLOR EXISTING
(PRINC
(STRCAT "\nEnter color of the layer set <" LSCOLOR ">: ")
)
(IF
(/= (SETQ NSN (GETSTRING))
""
)
(SETQ LSCOLOR NSN)
)
)
(IF ; IF LSCOLOR NOT EXISTING
(= (SETQ
LSCOLOR (GETSTRING "\nEnter color of the layer set <1>: ")
)
""
)
(SETQ LSCOLOR "1")
)
) ;_END-IF-LSCOLOR
;;
;; get a start number as suffix - SUFFIX
(IF SUFFIX
(PROGN ; IF SUFFIX EXISTING
(SETQ SUFFIX (1+ SUFFIX))
(PRINC
(STRCAT "\nEnter a start number <" (RTOS SUFFIX 2 0) ">: ")
)

(INITGET 4)
(IF (SETQ NSN (GETINT))
(SETQ SUFFIX NSN)
)
) ;_PROGN
(PROGN ; IF SUFFIX NOT EXISTING
(INITGET 4)
(IF (NULL (SETQ SUFFIX (GETINT "\nEnter a start number <0>: ")))
(SETQ SUFFIX 0)
)
) ;_PROGN
) ;_END-IF-SUFFIX
;;
;; get number of layers - LAMOUNT
(IF LAMOUNT
(PROGN ; IF LAMOUNT EXISTING
(PRINC
(STRCAT "\nEnter number of layers <"
(RTOS LAMOUNT 2 0)
">: "
)
)

(IF (> (SETQ NSN (GETINT)) 0)
(SETQ LAMOUNT NSN)
)
) ;_PROGN
(PROGN ; IF LAMOUNT NOT EXISTING
(IF (NULL
(SETQ LAMOUNT (GETINT "\nEnter number of layers <1>: "))
)
(SETQ LAMOUNT 1)
)
) ;_PROGN
) ;_END-IF-LAMOUNT
;;
;;
;;
(REPEAT LAMOUNT
(SETQ NEW_LAYER_NAME (STRCAT NSNAME "_" (RTOS SUFFIX 2 0)))
(SETQ NLDATA (LIST (CONS 0 "LAYER")
(CONS 100 "AcDbSymbolTableRecord")
(CONS 100 "AcDbLayerTableRecord")
(CONS 2 NEW_LAYER_NAME)
(CONS 70 0)
(CONS 62 (READ LSCOLOR))
)
)
(ENTMAKE NLDATA) ; MAKE A NEW LAYER
(SETQ SUFFIX (1+ SUFFIX))
) ;_END REPEAT
(PRINC)
) ; END-DEFUN