copy objects to new layers by lisp

[vanowm]

Try this code and hope you do not remove the author name of the code .

 

See reply #7

How do we go about highlighting current selected layer in that layers list?

 

[EDIT]

Got it:

    (setq lays (reverse lays)
         curlayer (getvar "CLAYER")
         index 0
         i 0
   )
   (start_list "layer")
   (foreach itm lays
       (add_list itm)
       (if (= itm curlayer)
           (setq index i)
       )
       (setq i (1+ i))
   )
   (end_list)
   (set_tile "layer" (itoa index))

Edited July 20, 2017 by vanowm

[Tharwat]

How do we go about highlighting current selected layer in that layers list?

 

Does it mean that you would like to highlight the newly copied objects or the firstly selected polylines?

[ronjonp]

How do we go about highlighting current selected layer in that layers list?

 

[EDIT]

Got it:

    (setq lays (reverse lays)
         curlayer (getvar "CLAYER")
         index 0
         i 0
   )
   (start_list "layer")
   (foreach itm lays
       (add_list itm)
       (if (= itm curlayer)
           (setq index i)
       )
       (setq i (1+ i))
   )
   (end_list)
   (set_tile "layer" (itoa index))

 

Another way is to append the current layer to the top of the list .. something like so:

(cons (getvar 'clayer) (vl-remove (getvar 'clayer) '("0" "Layer1" "Layer2")))

 

Then your index is always "0".

 

Or use vl-position if you don't want to change layer order:

(set_tile "layer" (itoa (vl-position (getvar 'clayer) lays)))

[vanowm]

Or use vl-position if you don't want to change layer order:

(set_tile "layer" (itoa (vl-position (getvar 'clayer) lays)))

Short and simple compare to what I came up with. Thank you!

 

Does it mean that you would like to highlight the newly copied objects or the firstly selected polylines?

No, I meant pre-select current layer's name at the layers list window. ronjnp's solution works great.

[itacad]

Hello! I started a topic where I explained that I am looking for a lisp to copy an object from one layer to others and this conversation was indicated to me.

I try the Tharwat's code and it's good for me, because the window with the layer list is very powerful!

In my topic it was discussed how to correct the code to solve the problem of non-alphabetical sorting...

http://www.cadtutor.net/forum/showthread.php?102949-Copy-object-to-other-layers&p=698985#post698985

It seems correct to continue here with further modification requests...

I would need the lisp to work with all types of objects (not just the polylines) or at least with blocks and texts...

Is it possible?

Thank you in advance

[vanowm]

On 5/25/2013 at 12:47 PM, Tharwat said:

Try this code and hope you do not remove the author name of the code .

 

 

(defun c:Test (/ *error* showdcl on lst ss i sn vl)
;;;--- Tharwat 25. May. 2013 ---;;;
 (or doc
     (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (defun *error* (x)
   (if doc
     (vla-endundomark doc)
   )
   (if f
     (progn (close f) (vl-file-delete fn))
   )
   (princ "\n*Cancel*")
 )
 (defun ShowDcl (/ sn f str dcl_id l lays pos)
   (setq fn (vl-filename-mktemp "dcl.dcl"))
   (setq f (open fn "w"))
   (foreach str
            (list
              "Layers : dialog { label = \"Layer List\"; fixed_width = true;"
              ": list_box { label = \"Select Layer\"; key = \"layer\"; width = 32; multiple_select = true;}"
              ": boxed_row { label = \"Action\";" ": row {"
              ": button { label = \"Accept\"; key = \"accept\"; is_default = true;  }"
              ": button { label = \"Cancel\"; key = \"cancel\"; is_cancel = true; }}}}")
     (write-line str f)
   )
   (close f)
   (setq dcl_id (load_dialog fn))
   (if (not (new_dialog "Layers" dcl_id))
     (exit)
   )
   (while (setq l (tblnext "LAYER" (not l)))
     (setq lays (cons (cdr (assoc 2 l)) lays))
   )
   (setq lays (reverse lays))
   (start_list "layer")
   (mapcar 'add_list lays)
   (end_list)
   (action_tile
     "accept"
     "(setq pos (get_tile \"layer\"))(done_dialog)"
   )
   (action_tile "cancel" "(done_dialog)")
   (start_dialog)
   (unload_dialog dcl_id)
   (if pos
     (foreach n (read (strcat "(" pos ")"))
       (setq lst (cons (nth n lays) lst))
     )
   )
 )
 (if (and (progn (princ "\n Select Polyline ...")
                 (setq ss (ssget "_:L" '((0 . "*POLYLINE"))))
          )
          (setq on (ShowDcl))
     )
   (progn
     (vl-file-delete fn)
     (vla-StartUndomark doc)
     (repeat (setq i (sslength ss))
       (setq sn (ssname ss (setq i (1- i))))
       (foreach x lst
         (vla-copy (setq vl (vlax-ename->vla-object sn)))
         (vla-put-layer vl x)
       )
     )
     (vla-endundomark doc)
   )
 )
 (princ "\n Written By Tharwat Al Shoufi")
 (princ)
)

 

 

Is there a way add colors to each layer name?