LISP file to create for every single polyline a new number after their layername

[Anonymous]

Hi,

Autodesk helpt me very well with making a LISP file for Autocad. That was actually what I needed, but when I started to use it, I wonder if it is possible to add one more thing to the LISP file. (File is added as an attachment).

Now the file can transfer every polyline, that is selected, to its one layer what I need. Layer names are new and the previous names of the layers are not use anymore. Like in this video is explained around 2:23 min.

https://knowledge.autodesk.com/support/autocad/learn-explore/caas/screencast/Main/Details/7ccb54c2-6...

What I actually need is that still every polyline is in a different layer, but it keeps it name that it had. So for example…

I have several polylines in my project with the layers a, b or c in my autocad file;

What I need is that the polylines keep this layer name but the script will add a unique number in the layer name for every polyline. So like a_1, a_2,b_1, b_2, c_1,c_2, etc.

Hope this is clear enough and hope you can help me with this.

Thanks in advance and appreciate your help!

[ВeekeeCZ · Accepted solution]

Simple enough.

(defun c:Pl2Layers ( / s i e o n a x l :CopyLayer)
  
  (defun :CopyLayer (o n / d )
    (if (setq d (entget (tblobjname "LAYER" o)))
      (entmake (list '(0 . "LAYER")
		     '(100 . "AcDbSymbolTableRecord")
		     '(100 . "AcDbLayerTableRecord")
		     (cons 2    n)
		     (assoc 70  d)
		     (assoc 62  d)
		     (assoc 6   d)
		     (assoc 290 d)
		     (assoc 370 d)
		     (assoc 390 d)))))
  
  (if (setq s (ssget "_:L" '((0 . "*POLYLINE"))))
    (repeat (setq i (sslength s))
      (setq e (ssname s (setq i (1- i)))
	    o (cdr (assoc 8 (entget e)))
	    l (if (setq a (assoc o l))
		(subst (cons o (setq x (1+ (cdr a)))) a l)
		(cons (cons o (setq x 1)) l))
	    n (strcat o "_" (itoa x)))
      (or (tblsearch "LAYER" n)
	  (:CopyLayer o n))
      (entmod (subst (cons 8 n) (cons 8 o) (entget e)))))
  (princ)
  )

[Anonymous]

@ВeekeeCZ Thank you very much! This script exactly does what I need. Legend!

[pbejse]

Quick question: 

What of the objects selected layers already has a suffix? will that be A_1_1?  leave it alone ? change to the next available number? 

[pbejse]

Pending queries: [ also cinderella time ]

(Defun c:PLaya ( / checkName made _reMade _newLay ss i ent lay clay p f)
(defun checkName  (s n)
      (while (tblsearch
                        "Layer"
                        (Setq ln (Strcat s "_" (itoa n))))
            (Setq n (1+ n)))
      (list ln n)
      )
      
(defun _reMade (cly / f)
      (if (setq f (assoc cly made))
          (progn
           	(setq gn (checkName cly (1+ (Cadr f)))
                      made (subst (list cly (Cadr gn)) f made))
                (car gn)
          		)
                      )
      )
(defun _newLay (cly n / gn)
      (setq gn (checkName cly n))
      (setq made (cons (list cly (cadr gn)) made))
      (Car gn)
      )
      
      
(if (setq ss (ssget "_:L" '((0 . "LWPOLYLINE"))));<-- this could be filtered for exclusion of ---
  	(repeat (Setq i (sslength ss))
  		(setq ent (entget (ssname ss (Setq i (1- i)))))
              	(Setq lay (entget (tblobjname  "LAYER"
                                        (setq clay (Cdr (Assoc 8 ent))))))
              	(Setq nlay 
              		(cond
                      		((and
                                       (wcmatch clay "*_#*")
                                       (Setq p (vl-string-position  95 clay))
                                       (numberp  (setq n (read (substr clay (+ 2 p)))))
                                       )
                                        (if (setq f (_reMade (substr clay 1 p))) f
                                            (_newLay (substr clay 1 p) n)
                                            )
                                 	)
                                ( (setq f (_reMade clay))	)
                              	( (_newLay clay 1) 		)
                              )
                      )                      	
              	(entmake (append
				(list (cons 0 "LAYER")
		                 	(cons 100 "AcDbSymbolTableRecord")
		                 	(cons 100 "AcDbLayerTableRecord")
		                 	(cons 2 nlay)
                                      )
                                      (mapcar '(lambda (d)(assoc d lay)) '(70 62 6 290 370))))
              	(entmod (subst (cons 8 nlay) (assoc 8 ent) ent))
              )
	)
    	
      (princ)
      )

I'll check back tomorrow