Jump to content

Recommended Posts

Posted

Hi all,

 

i often need to create a new layer that has same properties as some layer that already exist in drawing and/or in some simple way rename layer. without necessity of using annyoing layer prop manager or rename. just keep it simple,clean and fast from the command-line.

 

My idea was that following selection of an entity you could either copy (make new layer with same properties) or rename layer of selected entity. After some lisp tryouts i understood that its beyond my skills...

can somebody help me please?

 

thanks

Posted
Hi all,

 

i often need to create a new layer that has same properties as some layer that already exist in drawing and/or in some simple way rename layer. without necessity of using annyoing layer prop manager or rename. just keep it simple,clean and fast from the command-line.

 

My idea was that following selection of an entity you could either copy (make new layer with same properties) or rename layer of selected entity. After some lisp tryouts i understood that its beyond my skills...

can somebody help me please?

 

thanks

 

Welcome to CADTutor. :) On the LAYERS 2 toolbar there are a few great tools or commands. One of those is COPYTOLAYER. You can also call it at the commandline. If you select an entity which is on a layer with the same settings you want for your new layer, and choose the NAME option midcommand, you can specify a nonexistent layer name, and after confirming that you want to create a layer by that name it will be created.

Posted

thank you for your reply! the problem is: COPYTOLAYER doesnt keep the same properties (color, linetype, lineweight).

Posted

I am sorry that you do not like using the Layer Properties Manager, because what you want to do is very simple.

 

You click on the Layer that you want to copy, then click on New. The new layer has all the properties of the first layer, and just needs a name, (or defaults to Layer1).

LayerPropMan.JPG

Posted

thats my daily routine im trying to avoid:) the problem is that most of the time i need to work on drawings with thousands of layers and layer prop manager often slows down autocad. so im using old CLASSICLAYER... it seems much faster than layer prop manager

Posted (edited)

The properties which will be applied to the new layer being created, when you

specify a new layer name,

are the same as those of the CURRENT LAYER, not the same as those

of the layer from which the entity is being copied.

 

Much as eldon points out, but without the need of the layer properties manager, first make sure that your current layer

has the properties you want applied to the new layer.

If you do it this way I believe you will find that all the properties are as you would like.

Edited by Dadgad
Posted

Would this be of any assistance ?

 

Hope you have the Express Tools installed on your system to enjoy the selection set drag mode function :D

 

(defun c:Test (/ ss p1 p2 i sn lst l)
 ;;___ Tharwat 12. May. 2013 ___;;
 (if
   (and
     (setq ss (ssget "_:L"))
     (setq p1 (getpoint "\n Specify base point :"))
     (setq p2 (acet-ss-drag-move ss p1 "\n Specify second point :"))
     (repeat (setq i (sslength ss))
       (setq sn (ssname ss (setq i (1- i))))
       (setq lst (cons (vla-copy (vlax-ename->vla-object sn)) lst))
     )
   )
    (progn
      (foreach e lst
        (vla-move e (vlax-3d-point p1) (vlax-3d-point p2))
      )
      (while
        (and (/= "" (setq l (getstring t "\n Specify New Layer Name :")))
             (snvalid l)
             (tblsearch "LAYER" l)
        )
         (princ
           "\n Unvalid name of layer or it's already existed ! TRY AGAIN "
         )
      )
      (if (not (tblsearch "LAYER" l))
        (progn
          (vla-add (vla-get-layers
                     (vla-get-activedocument (vlax-get-acad-object))
                   )
                   l
          )
          (foreach o lst (vla-put-layer o l))
        )
      )
    )
 )
 (princ "\n Written by Tharwat ...")
 (princ)
)
(vl-load-com)

Posted (edited)

May be this

	(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
	;; ListBox (gile)
	;; Dialog box to choose one or more in a list
	;;
	;; Arguments
	;; title : the dialog title (string)
	;; msg ; message (string), "" or nil for none
	;; keylab : an dotted pairs list of type ((key1 . label1) (key2 . label2) ...)
	;; flag : 0 = popup list
	;;        1 = single choice list box
	;;        2 = multipe choices list box
	;;
	;; Return value : the choosen key (flag = 0 or 1) or the list of choosen keys (flag = 2)
	;;
	;; Using example
	;; (listbox "Layout" "Choose a layout" (mapcar 'cons (layoutlist) (layoutlist)) 1)

	;; create and open a temporay file
	  (setq	tmp  (vl-filename-mktemp "tmp.dcl")
		file (open tmp "w")
	  )
		;; write the file according to arguments
	  (write-line
	    (strcat "ListBox:dialog{label=\"" title "\";")
	    file
	  )
	  (if (and msg (/= msg ""))
	    (write-line (strcat ":text{label=\"" msg "\";}") file)
	  )
	  (write-line
	    (cond
	      ((= 0 flag) "spacer;:popup_list{key=\"lst\";")
	      ((= 1 flag) "spacer;:list_box{key=\"lst\";allow_accept = true;")
	      (T "spacer;:list_box{key=\"lst\";multiple_select=true;")
	    )
	    file
	  )
	  (write-line "}spacer;ok_cancel;}" file)
	  (close file)
		
		;; load the file and show the dialog
	  (setq dcl_id (load_dialog tmp))
	  (if (not (new_dialog "ListBox" dcl_id))
	    (exit)
	  )
	  (start_list "lst")
	  (mapcar 'add_list (mapcar 'cdr keylab))
	  (end_list)
	  (action_tile
	    "accept"
	    "(or (= (get_tile \"lst\") \"\")
	    (if (= 2 flag) (progn
	    (foreach n (str2lst (get_tile \"lst\") \" \")
	    (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice)))
	    (setq choice (reverse choice)))
	    (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))))
	    (done_dialog)"
	  )
	  (start_dialog)
	  (unload_dialog dcl_id)
	  (vl-file-delete tmp)
	  choice
	)
(defun make-copy-layer (New_Layer_Name Owner_Layer_Name / tmp ) 
;;;http://www.caduser.ru/forum/index.php?PAGE_NAME=message&FID=2&TID=47868&PAGEN_1=2
;;;Functionh to create a copy of the layer
;;; New_Layer_Name - the name of the new layer
;;; Owner_Layer_Name - name of the copied layer
;;; Returns ename copy created layer or nil
;;; (Make-copy-layer "My new layer" "0")

 (if (and (setq tmp (tblobjname "LAYER" Owner_Layer_Name)) 
          (setq tmp (entget tmp)) 
          (snvalid New_Layer_Name 0) 
          (not (tblsearch "LAYER" New_Layer_Name)) 
          ) 
   (entmakex (subst (cons 2 New_Layer_Name)(assoc 2 tmp) tmp)) 
   ) 
 )
;;;Written By Michael Puckett. 
;;;(setq all_layers (tablelist "LAYER"))
 (defun tablelist (s / d r)
     (while (setq d (tblnext s (null d)))
       (setq r (cons (cdr (assoc 2 d)) r))
     );_ while
   );_ defun
(defun c:test ( / e1 _l _n _nl ) 
(if 
  (setq e1 (entsel "\nPlease select a primitive copy of the layer you want to get <exit>: ")) 
  (progn       
      (print (setq _l (cdr(assoc 8 (entget(car e1)))))) 
      (setq _nl (getstring t "\nNew layer name: ")) 
      (if (make-copy-layer  _nl _l) (setvar "clayer" _nl)) 
  )) 
);defun
(defun C:test1 ( / _nl _l )
 (vl-load-com)
 (and
 (setq _l  
 (listbox "Layer" "Select exist layer"
   ((lambda(l)(mapcar 'cons l l))(vl-remove-if-not 'snvalid (tablelist "LAYER")))
   1
   )
)
 (setq _nl (getstring t "\nNew layer name: "))
 (snvalid _nl 0)
 (if (make-copy-layer  _nl _l) (setvar "clayer" _nl))
 )
(princ)
 )
 (princ "\n type Test or Test1 in command line")(princ)

 

Copy layer properties from one layer to another

Edited by VVA
Add new command Test1
Posted

Dadgad,

my apologies, you are right!

 

Tharwat,

thank you, but new layer has default properties

 

VVA,

thank you! both are excellent!!!:thumbsup:

Posted

my initial idea for let say "rename layer" came from "Block Rename" which does exactly what i want with exception that is renaming blocks and not layers...after some time i understood i was horribly mistaken that even without programming skills i could simply modify it to "rename layer"

Posted
May be this

(defun make-copy-layer (New_Layer_Name Owner_Layer_Name / tmp ) 
;;;http://www.caduser.ru/forum/index.php?PAGE_NAME=message&FID=2&TID=47868&PAGEN_1=2
;;;Functionh to create a copy of the layer
;;; New_Layer_Name - the name of the new layer
;;; Owner_Layer_Name - name of the copied layer
;;; Returns ename copy created layer or nil
;;; (Make-copy-layer "My new layer" "0")

(if (and (setq tmp (tblobjname "LAYER" Owner_Layer_Name)) 
(setq tmp (entget tmp)) 
(snvalid New_Layer_Name 0) 
(not (tblsearch "LAYER" New_Layer_Name)) 
) 
(entmakex (subst (cons 2 New_Layer_Name)(assoc 2 tmp) tmp)) 
) 
) 
(defun c:test ( / e1 _l _n ) 
(if 
(setq e1 (entsel "\nPlease select a primitive copy of the layer you want to get <exit>: ")) 
(progn 
(print (setq _l (cdr(assoc 8 (entget(car e1)))))) 
(setq _nl (getstring "\nNew layer name: ")) 
(if (make-copy-layer _nl _l) (setvar "clayer" _nl)) 
)) 
);defun

 

Copy layer properties from one layer to another

 

Tried this one out...it's working but what if i wish to use layer names with space?

if i use the spacebar, it ends the routine.

Posted
Tried this one out...it's working but what if i wish to use layer names with space?

if i use the spacebar, it ends the routine.

 

Did you try to add t after the function getstring to allow you have a space with your string input ? ;)

Posted
Did you try to add t after the function getstring to allow you have a space with your string input ? ;)

 

Thanks a lot Tharwat!

Posted
Good solution VVA.

 

Thanks Lee.

I edit #8

Take into account the wish of nod684 and added a layer selection of dialogue

Posted

VVA,

tested and works nicely! thanks!

Posted

Would it be possible automatically append some suffix for new copy of layer?

 

eg. you want to make copy of layer01

when it ask for new layer name instead of

New layer name:

 

would be

New layer name :

Posted

New version Test1. Need some function from #8

(defun C:test1 ( / _nl _l suff )
 (vl-load-com)
 (setq suff "_temp")
 (and
 (setq _l  
 (listbox "Layer" "Select exist layer"
   ((lambda(l)(mapcar 'cons l l))(vl-remove-if-not 'snvalid (tablelist "LAYER")))
   1
   )
)
 (setq _nl (getstring t (strcat "\nNew layer name <" _l suff ">:")))
 (if (eq _nl "")(setq _nl (strcat _l suff)) t)
 (snvalid _nl 0)
 (if (make-copy-layer  _nl _l) (setvar "clayer" _nl))
 )
(princ)
 )

Posted

VVA,

excellent! It works nicely!

Thanks a lot!:thumbsup:

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...