Rename suffix based on list value

[yann_fradier]

Hello everyone and thank you for your help,

I try to adapt the lsp evoked on the forum for my case but that exceeds my competence in this field ^^.

I would like an lsp to rename the suffixes of the layers according to the name of each of them

Example: 

Suffixe "02-SURFACE"

Layer list: [ZRAEX;ZEX;ZDECAP]

Example after lsp: 02-SURFACE-ZRAEX

Suffixe "03-CADASTRE"

Layer list: [PARCELLE]

Example after lsp: 03-CADASTRE-PARCELLE

Suffixe "04-topo"

Layer list: [BT,HT,POINT]

Example after lsp: 04-TOPO-BT

[komondormrex · Accepted solution]

check the following

(defun add_layer_prefix  (layer_list prefix date_list / new_layer_name layer_collection layer_name renamed new_layer)
	(vlax-map-collection (setq layer_collection (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
		'(lambda (layer)
			(if (member (strcase (setq layer_name (vla-get-name layer))) (mapcar 'strcase layer_list))
				(progn
				  	(setq renamed nil)
					(foreach date date_list
						(if (and
							(setq new_layer_name (strcat prefix "-" date "-" layer_name))
							(vl-catch-all-error-p 
								(vl-catch-all-apply 'vla-item (list (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
											  						new_layer_name
												  			  )
								)
							)
						    )
							(if (not renamed) 
								(setq renamed (not (vla-put-name layer new_layer_name)))
							  	(progn
									(setq new_layer (vla-add layer_collection new_layer_name))
								  	(mapcar 'eval
										 (mapcar '(lambda (property) (list (read (strcat "vla-put-" (vl-symbol-name property))) 'new_layer  (vlax-get layer property)))
										         '(Description Freeze LayerOn Linetype Lineweight Lock Material Plottable TrueColor ViewportDefault)
									         )
									)
								  	(entmod (subst (assoc -3 (entget (vlax-vla-object->ename layer) '("*")))
										       (assoc -3 (entget (vlax-vla-object->ename new_layer) '("*")))
										       (entget (vlax-vla-object->ename new_layer) '("*"))
									      	)
									)
							  	)
							)
							(alert (strcat "Layer \"" new_layer_name "\" already exists"))
						)
			  		)
				)
		  	)
		)
	)
	(princ)
)

;to run type in command line (add_layer_prefix '("ZRAEX" "ZEX" "ZDECAP") "02-SURFACE" '("17-11-2023" "17-10-2023" "17-09-2023")) <Enter>

[yann_fradier]

This time we have a perfect result.

Thank you very much for the valuable and quick help.

[pbejse]

---

@yann_fradier wrote:

I would like an lsp to rename the suffixes of the layers according to the name of each of them

(defun c:Laypref ( / a b td layname )
(setq td (menucmd "M=$(edtime,$(getvar,date),MO-DD-YYYY)"))
  
	(While (setq a (tblnext "Layer" (null a)))
	  (setq	layname	(cdr (assoc 2 a))
		b	(entget (tblobjname "layer" layname))
	  )
	  (vl-some
	    '(lambda (ln)
	       (if (member layname (car ln))
		 (entmod
		   (subst (cons 2 (strcat (cadr ln) td "-" layname)) (assoc 2 b) b)
		 )
	       )
	     )
	    '((("ZRAEX" "ZEX" "ZDECAP") "02-SURFACE-")
	      (("PARCELLE") "03-CADASTRE-")
	      (("BT" "HT" "POINT") "04-TOPO-")
	    )
	  )
	)(princ)
       )

[yann_fradier]

I dare to ask again for your services.

The duplicated source layers contain objects (point, line, block).

Would it be possible for the layers created from your program to duplicate the objects also in similar layers with the new dates?

[yann_fradier]

Thanks for the feedback,
Komondormex script responds well to my request. I just updated the post because I also want to duplicate the objects present in my source layers to keep them in the new ones.

[komondormrex · Accepted solution]

sure,

check the following

(defun add_layer_prefix  (layer_list prefix date_list / new_layer_name layer_collection layer_name renamed new_layer layer_object_sset layer_processed)
  	(setq layer_processed 0)
	(vlax-map-collection (setq layer_collection (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
		'(lambda (layer)
			(if (member (strcase (setq layer_name (vla-get-name layer))) (mapcar 'strcase layer_list))
				(progn
				  	(setq renamed nil)
					(foreach date date_list
						(if (and
							(setq new_layer_name (strcat prefix "-" date "-" layer_name))
							(vl-catch-all-error-p 
								(vl-catch-all-apply 'vla-item (list (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
											  						new_layer_name
												  			  )
								)
							)
						    )
							(if (not renamed) 
								(setq renamed (not (vla-put-name layer new_layer_name)))
							  	(progn
									(setq new_layer (vla-add layer_collection new_layer_name))
								  	(mapcar 'eval
										 (mapcar '(lambda (property) (list (read (strcat "vla-put-" (vl-symbol-name property))) 'new_layer  (vlax-get layer property)))
										         '(Description Freeze LayerOn Linetype Lineweight Lock Material Plottable TrueColor ViewportDefault)
									         )
									)
								  	(entmod (subst (assoc -3 (entget (vlax-vla-object->ename layer) '("*")))
										       (assoc -3 (entget (vlax-vla-object->ename new_layer) '("*")))
										       (entget (vlax-vla-object->ename new_layer) '("*"))
									      	)
									)
								  	(if (setq layer_object_sset (ssget "_x" (list (cons 8 (vla-get-name layer)))))
									  (foreach object (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex layer_object_sset))))
									     (vla-put-layer (vla-copy object) new_layer_name)
									  )
								  	)
							  	)
							)
							(alert (strcat "Layer \"" new_layer_name "\" already exists"))
						)
			  		)
				  	(princ (strcat "\nLayer \"" layer_name "\" has been processed."))
				  	(setq layer_processed (1+ layer_processed))
				)
		  	)
		)
	)
  	(if (zerop layer_processed) (princ "\nNo layer found to process."))
	(princ)
)

;to run type in command line (add_layer_prefix '("ZRAEX" "ZEX" "ZDECAP") "02-SURFACE" '("17-11-2023" "17-10-2023" "17-09-2023")) <Enter>

[pbejse · Accepted solution]

---

@yann_fradier wrote:

Thanks for the feedback,
Komondormex script responds well to my request. I just updated the post because I also want to duplicate the objects present in my source layers to keep them in the new ones.

---

That's all good and understood @yann_fradier 

Tell me if my contribution were able to address your request or is it totally off?

[yann_fradier]

Yes it works perfectly for a single date

Thank you for your contribution

[yann_fradier]

It’s perfect and effective!

Thank you for the valuable contribution