Topic: Help needed to get the code to work

[cadd4la]

Hi everyone,

I need help getting this code to work. I'm looking for the code to create a new layer with a given name, color, and layer description, then move all the items on a given layer to this new layer.

Code: [Select]

(defun c:move_from_defpoints ()
  (setq ssl0 (ssget "x" '((8 . "Defpoints"))))
  (if (not ssl0)
    (progn
      (princ "\nNo objects found on Defpoints layer.")
      (exit)
    )
    (progn
      (setq layername "fromDefpoints")
      (if (tblsearch "LAYER" layername)
        (command "_-LAYDEL" layername "")
      )
      (command "_-LAYER" "N" layername "C" "200" "" "Items moved from the Defpoints layer" "")
      (command "_.CHPROP" ssl0 "" "LA" layername "")
      (princ (strcat "\nObjects moved to layer: " layername))
    )
  )
  (princ)
)
I was able to get the code to make the new layer with the name only but it will not make the layer color or the layer description that I want and it changes the current layer color to the color that I want the new layer to be.

Thanks,

Cadd4la

[ronjonp]

Welcome to TheSwamp. Here's some code with comments, maybe you can learn from it. My first advice would be to try and stay away from command calls:

Code - Auto/Visual Lisp: [Select]

1. (defun c:move_from_defpoints (/ layername newlayer ssl0);;<-Localize variables ( anything SETQ )
2.   (if (not (setq ssl0 (ssget "x" '((8 . "Defpoints")))))
3.     (princ "\nNo objects found on Defpoints layer.")
4.     (progn (setq layername "fromDefpoints")
5.            ;; Create the new layer object
6.            (setq newlayer (vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
7.                                    layername
8.                           )
9.            )
10.            ;; Change the color
11.            (vla-put-color newlayer 200)
12.            ;; Add a description
13.            (vla-put-description newlayer "Items moved from the Defpoints layer")
14.            ;; Convert the selection set to a list and go through each item
15.            (foreach e (mapcar 'cadr (ssnamex ssl0))
16.              ;; Catch-all just incase layer defpoints is locked ( or we could check above )
17.              (vl-catch-all-apply 'vla-put-layer (list (vlax-ename->vla-object e) layername))
18.            )
19.            ;; Print your message
20.            (princ (strcat "\nObjects moved to layer: " layername))
21.     )
22.   )
23.   (princ)
24. )
25. ;; Loads ActiveX functions vla-*
26. (vl-load-com)

[cadd4la]

Ronjonp,

Thank you for your help, it works great!

Cadd4la