Copy all Layer Names and then Add Suffix

[rcb007]

I am trying to figure out how to be able to copy all the layer names in a dwg. Then the new take the copied layer names and add a suffix to them.

Is that possible? I know i have found some routines that can add suffix to all layer names but not sure if i can keep the original names as well.

 

thank you for your help

[dlanorh]

41 minutes ago, rcb007 said:

I am trying to figure out how to be able to copy all the layer names in a dwg. Then the new take the copied layer names and add a suffix to them.

Is that possible? I know i have found some routines that can add suffix to all layer names but not sure if i can keep the original names as well.

 

thank you for your help

 

Test this. It only creates the new layers with default property settings (color 7, linetype "continuous" etc) If you require the new layers to inherit properties let me know.

 

(defun c:clws ( / *error* c_doc c_lyrs lyr_lst suf)

  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : < " msg " > occurred.")))
    (princ)
  );_end_*error*_defun

  (setq c_doc (vlax-get-property (vlax-get-acad-object) 'activedocument)
        c_lyrs (vlax-get-property c_doc 'layers)
  );end_setq

  (vlax-map-collection c_lyrs '(lambda (x) (setq lyr_lst (cons (vlax-get-property x 'name) lyr_lst))))

  (setq suf (getstring "\nEnter Layer Suffix text : "))

  (foreach lyr lyr_lst (vla-add c_lyrs (strcat lyr suf)))

  (princ)
)

 

 

[rcb007]

This works great. If its ok, would you do one that inherits the previously copied layer properties?

Again. Thank you.

[Jonathan Handojo]

Might not be entirely foolproof:

 

(defun c:laysuff ( / lys nm suff)
    (setq suff (getstring T "\nSpecify suffix to add: "))
    (while (setq nm (tblnext "Layer" (null nm)))
	(setq lys
		 (cons
		     (list
			 (cons 2 (strcat (cdr (assoc 2 nm)) suff))
			 (assoc 70 nm)
			 (assoc 62 nm)
			 (assoc 6 nm)
			 )
		     lys
		     )
	      )
	)
    (foreach x lys
	(entmake
	    (append
		'(
		  (0 . "LAYER")
		  (100 . "AcDbSymbolTableRecord")
		  (100 . "AcDbLayerTableRecord")
		  )
		x
		)
	    )
	)
    (princ)
    )

 

[rcb007]

I think it works! Thank you for taking your time with it!

[dlanorh]

As requested

 

(defun c:clws ( / *error* c_doc c_lyrs lyr_lst suf)

  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : < " msg " > occurred.")))
    (princ)
  );_end_*error*_defun

  (setq c_doc (vlax-get-property (vlax-get-acad-object) 'activedocument)
        c_lyrs (vlax-get-property c_doc 'layers)
        prplst (list 'freeze 'layeron 'linetype 'lineweight 'lock 'plottable 'truecolor 'viewportdefault)
  );end_setq

  (vlax-map-collection c_lyrs '(lambda (x) (setq lyr_lst (cons (vlax-get-property x 'name) lyr_lst))))

  (setq suf (getstring "\nEnter Layer Suffix text : "))

  (foreach lyr lyr_lst
    (setq pr_vals (mapcar '(lambda (x) (vlax-get-property (vla-item c_lyrs lyr) x)) prplst)
          n_lyr (vla-add c_lyrs (strcat lyr suf))
    );end_setq
    (mapcar '(lambda (x y) (vlax-put-property n_lyr x y)) prplst pr_vals)
  );end_foreach
  (princ)
);end_defun

This copies all properties including if the layer is locked, frozen, off etc.

[Jonathan Handojo]

16 minutes ago, rcb007 said:

I think it works! Thank you for taking your time with it!

 

No worries. dlanorh's approach is definitely more robust. Mine is faster than dlanorh's, but is less robust and copies locked, frozen, off, linetype... that's as far as I know

[Tharwat]

My attempt.

(defun c:foo ( / suf lay str new lst)
  ;; Tharwat , 22.May.2020	;;
  (and (setq suf (getstring t "\nSpecify your desired suffix for newly layers : "))
       (/= suf "")
       (setq suf (vl-string-left-trim " " suf))
       (while (setq lay (tblnext "LAYER" (null lay)))
         (and (setq str (cdr (assoc 2 lay)))
              (or (wcmatch str "*|*")
                  (tblsearch "LAYER" (setq new (strcat suf str)))
                  (setq lst (cons (list str new) lst)) 
                  )
              )
         )
       )
  (foreach itm lst
    (entmake (append (entget (tblobjname "LAYER" (car itm))) (list (cons 2 (cadr itm)))))
    )
  (princ)
  ) (vl-load-com)

 

[Dadgad]

Looks like you are probably pretty well sorted after all those helpful posts. 

 

Additionally you might want to check out the LAYTRANS command and functionality, which can be very useful when receiving and working on drawings from others.

You can create and save Layer Mappings which you might want to use in house when working on drawings from specific outside vendors.

[BIGAL]

Look into the "-rename" function as well * prefix* can do multi layers by a name group. Does not detect frozen or off.

Edited May 24, 2020 by BIGAL

[ronjonp]

This too:

(defun c:foo (/ a b c)
  (if (/= "" (setq a (getstring t "\nSpecify suffix to add: ")))
    (while (setq b (tblnext "LAYER" (null b)))
      (or (wcmatch (strcase (setq c (cdr (assoc 2 b)))) (strcat "0,DEFPOINTS,*|*,*" (strcase a)))
	  (entmakex (append (entget (tblobjname "LAYER" c)) (list (cons 2 (strcat c a)))))
      )
    )
  )
  (princ)
)

 

Edited June 4, 2020 by ronjonp