copy objects to new layers by lisp

Any suggestion for copy objects to new layers by lisp ??

Start here:

(Command "CopyToLayer")

So thanx to your attention

You may need to take a deep look into the following thread which is hasn't been discussed long a go .

http://www.cadtutor.net/forum/showthread.php?79266-copy-rename-layer

thanxxxxxxxxxxxxxxxxxxxxxxxx a lot

thanxxxxxxxxxxxxxxxxxxxxx

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)
)

Here is an example:

([color=BLUE]defun[/color] c:c2lay ( [color=BLUE]/[/color] inc lay lst obj sel )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color]))
       ([color=BLUE]progn[/color]
           ([color=BLUE]while[/color] ([color=BLUE]setq[/color] lay ([color=BLUE]tblnext[/color] [color=MAROON]"layer"[/color] ([color=BLUE]not[/color] lay)))
               ([color=BLUE]if[/color] ([color=BLUE]zerop[/color] ([color=BLUE]logand[/color] 52 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 70 lay))))
                   ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 lay)) lst))
               )
           )
           ([color=BLUE]if[/color] ([color=BLUE]setq[/color] lst (LM:listbox [color=MAROON]"Select Layers to Copy to"[/color] ([color=BLUE]acad_strlsort[/color] lst) [color=BLUE]t[/color]))
               ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] inc ([color=BLUE]sslength[/color] sel))
                   ([color=BLUE]setq[/color] obj ([color=BLUE]vlax-ename->vla-object[/color] ([color=BLUE]ssname[/color] sel ([color=BLUE]setq[/color] inc ([color=BLUE]1-[/color] inc)))))
                   ([color=BLUE]foreach[/color] lay lst
                       ([color=BLUE]vla-put-layer[/color] ([color=BLUE]vla-copy[/color] obj) lay)
                   )
               )
               ([color=BLUE]princ[/color] [color=MAROON]"\n*Cancel*"[/color])
           )
       )
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

You will need to download and load my List Box function before running the above.

thanxxxxxxxxxxxxxxxxxxxxxxxx a lot

Kisses for Tharwat

As BlackBox said, COPYTOLAYER. No need for code.

As BlackBox said, COPYTOLAYER. No need for code.

*Tips hat*

*Tips hat*

 

likewise

Kisses for Tharwat

.....

The routine of Tharwat works perfectly, but could be adapted to select all objets in the layer of the object selected. Thax

Here is an example:

([color=BLUE]defun[/color] c:c2lay ( [color=BLUE]/[/color] inc lay lst obj sel )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color]))
       ([color=BLUE]progn[/color]
           ([color=BLUE]while[/color] ([color=BLUE]setq[/color] lay ([color=BLUE]tblnext[/color] [color=MAROON]"layer"[/color] ([color=BLUE]not[/color] lay)))
               ([color=BLUE]if[/color] ([color=BLUE]zerop[/color] ([color=BLUE]logand[/color] 52 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 70 lay))))
                   ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 lay)) lst))
               )
           )
           ([color=BLUE]if[/color] ([color=BLUE]setq[/color] lst (LM:listbox [color=MAROON]"Select Layers to Copy to"[/color] ([color=BLUE]acad_strlsort[/color] lst) [color=BLUE]t[/color]))
               ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] inc ([color=BLUE]sslength[/color] sel))
                   ([color=BLUE]setq[/color] obj ([color=BLUE]vlax-ename->vla-object[/color] ([color=BLUE]ssname[/color] sel ([color=BLUE]setq[/color] inc ([color=BLUE]1-[/color] inc)))))
                   ([color=BLUE]foreach[/color] lay lst
                       ([color=BLUE]vla-put-layer[/color] ([color=BLUE]vla-copy[/color] obj) lay)
                   )
               )
               ([color=BLUE]princ[/color] [color=MAROON]"\n*Cancel*"[/color])
           )
       )
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

 

You will need to download and load my List Box function before running the above.

Why do I need the list box?

Thx

Why do I need the list box?

Thx

Because the function 'LM:listbox' will otherwise be undefined.

Because the function 'LM:listbox' will otherwise be undefined.

I have both code on my contents file, but when I run c2lay

I select a item and then stops the routine without any result.

Can you help me

Best regards

when I run c2lay I select a item and then stops the routine without any result.

Is the dialog displayed?

Do you receive any error messages at the command-line?

Is the dialog displayed?

Do you receive any error messages at the command-line?

No, nothing happens, no pop ups, I select an object and stops

Is the object on a locked layer?