Autolisp to change all objects on layer "0" to an existing layer "PC - Module"

[mikeyman5000]

Hi people,

I'd like to have/write a lisp to change all objects on layer "0" to layer "PC - Module"

If possible also;

1. save the document
2. close the document
3. open next in directory
4. run layer changer program again

Thanks for the help. I am using AUTOcad 2012 without VBA installed.

[_Tharwat · Accepted solution]

Here is my version .... ( without point 3 and 4 )

(defun c:test (/ f l ss i sn e)
;;; Tharwat 31. may. 2012 ;;;
  (if
    (and (setq f (tblsearch "LAYER" "PC - Module"))
         (setq
           l (not
               (eq (logand 4 (cdr (assoc 70 (tblnext "LAYER" "0")))) 4)
             )
         )
    )
     (if (setq ss (ssget "_x" '((8 . "0"))))
       (repeat (setq i (sslength ss))
         (setq sn (ssname ss (setq i (1- i))))
         (entmod (subst (cons 8 "PC - Module")
                        (assoc 8 (setq e (entget sn)))
                        e
                 )
         )
       )
       (princ "\n Not found objects on Layer < 0 >")
     )
     (if (not f)
       (princ "\n Layer < PC - Module >is not found in drawing !!")
       (princ "\n Layer < 0 > is locked !!!")
     )
  )
  (if (and f l)
    (progn (command "_.qsave") (command "_.close"))
  )
  (princ)
)

[mikeyman5000]

Thats fantastic! It works well for me, thanks for your help! Now I gotta figure out or if anyone knows how to do the visual lisp part of open next file.

Thanks again!

[_Tharwat]

---

@mikeyman5000 wrote:

Thats fantastic! It works well for me, thanks for your help! Now I gotta figure out or if anyone knows how to do the visual lisp part of open next file.

Thanks again!

---

You're welcome ,

load the lisp file and add it to the content folder to be able to run the code with every opened drawing .

and after that , Open  your drawings ( as much as your Autocad can afford ) and just type the name of the routine in every opened drawing .

This would fasten your works .and good luck

Tharwat

[pbejse]

command: 0topc

 
(defun c:0toPc ( / _Tolayer )
(defun _Tolayer  (doc / layers)
      (if (tblsearch "Layer" "PC - Module")
            (progn
                  (setq layers (vla-get-layers doc))
                  (vla-add layers "PC - Module")
                  (vla-put-lock (vla-item layers "0") :vlax-false)
                  (vlax-for
                         layout  (vla-get-layouts doc)
                        (vlax-for
                               object  (vla-get-block layout)
                              (if (eq (vla-get-layer object)
                                      "0")
                                    (vla-put-layer
                                          object
                                          "PC - Module"))))
                  )
            )
      )

     
    (LM:ODBX '_Tolayer nil t)
    (princ)
)

You need the sub LM:ODBX form this website -->  Lee Mac Proggraming <---

Then you're on your way to process hundreds of files in minutes.

Holler If you need help putting this together

For an opened draiwng

command: TolayerPC

(defun c:TolayerPC  (/ _Process doc layers)
      (setq doc    (vla-get-ActiveDocument (vlax-get-acad-object))
            layers (vla-get-layers doc))
      (defun _Process  (lay lays do)
            (vla-add lays lay)
            (vla-put-lock (vla-item lays "0") :vlax-false)
            (vlax-for
                   layout
                         (vla-get-layouts do)
                  (vlax-for
                         object
                               (vla-get-block layout)
                        (if (eq (vla-get-layer object) "0")
                              (vla-put-layer object "PC - Module"))))
            )
      (if (tblsearch "LAYER" "PC - Module")
            (_process "PC - Module" layers doc)
            (progn
                  (princ "\nPC - Module does not exist: ")
                  (initget 1 "Y N")
                  (if (eq (getkword "\nCreate Layer [Y/N]: ") "Y")
                        (_process "PC - Module" layers doc))
                  )
            )

      (princ)
      )

[_Tharwat]

---

@pbejse wrote:

      (if (tblsearch "Layer" "PC - Module")
            (progn
                  (setq layers (vla-get-layers doc))
                  (vla-add layers "PC - Module")
 ..........................

     ........................................................
      (if (tblsearch "LAYER" "PC - Module")
            (_process "PC - Module" layers doc)
            (progn
                  (princ "\nPC - Module does not exist: ")   

---

@pbejse , just a clarfication and I could be wrong .

Why you are adding the layer "PC - Moudle" since the search of Layers found it in the layer's Table into your two routines ?

[pbejse]

---

@_Tharwat wrote:

@pbejse , just a clarfication and I could be wrong .

Why you are adding the layer "PC - Moudle" since the search of Layers found it in the layer's Table into your two routines ?

---

Good catch, at first i was inteding to create layer regardless it the user wants to creat or not, then i change my mind when i read the OPs post again.

So it should be

(defun c:TolayerPC  (/ _Process doc layers)
      (setq doc    (vla-get-ActiveDocument (vlax-get-acad-object))
            layers (vla-get-layers doc))
      (defun _Process  (lay lays do)
            (vla-put-lock (vla-item lays "0") :vlax-false)
            (vlax-for
                   layout
                         (vla-get-layouts do)
                  (vlax-for
                         object
                               (vla-get-block layout)
                        (if (eq (vla-get-layer object) "0")
                              (vla-put-layer object lay))))
            )
      (if (tblsearch "LAYER" "PC - Module")
            (_process "PC - Module" layers doc)
                  (cond ((and
                        (princ "\nPC - Module does not exist: ")
                   (not (initget 1 "Y N"))
                        (eq (getkword "\nCreate Layer [Y/N]: ") "Y")
                        (vla-add layers "PC - Module")
                        (_process "PC - Module" layers doc))
   )
                    )   
            )
      (princ)
      )

As for  0topc , that line should not even be there

(defun c:0toPc ( / _Tolayer )
(defun _Tolayer  (doc / layers)
      (if (tblsearch "Layer" "PC - Module")
            (progn
                  (setq layers (vla-get-layers doc))
                  (vla-put-lock (vla-item layers "0") :vlax-false)
                  (vlax-for
                         layout  (vla-get-layouts doc)
                        (vlax-for
                               object  (vla-get-block layout)
                              (if (eq (vla-get-layer object)
                                      "0")
                                    (vla-put-layer
                                          object
                                          "PC - Module"))))
                  )
            )
      )

    
    (LM:ODBX '_Tolayer nil t)
    (princ)
)

Unless the OP wants to run the rouitne regardless the layer in question is existing or not

(defun c:0toPcM ( / _Tolayer )
(defun _Tolayer  (doc / layers)
                  (setq layers (vla-get-layers doc))
                  (vla-add layers "PC - Module")
                  (vla-put-lock (vla-item layers "0") :vlax-false)
                  (vlax-for
                         layout  (vla-get-layouts doc)
                        (vlax-for
                               object  (vla-get-block layout)
                              (if (eq (vla-get-layer object)
                                      "0")
                                    (vla-put-layer
                                          object
                                          "PC - Module"))))
                  )
    (LM:ODBX '_Tolayer nil t)
    (princ)
)

thank you for testing the codes tharwat

Cheers

[_Tharwat]

---

@pbejse wrote:

---

thank you for testing the codes tharwat

Cheers

---

It is my pleasure .

I think the not function could handle the issue of your first two routines . ( if I am not mistaken )

Best regards.

[pbejse]

---

@_Tharwat wrote:

It is my pleasure .

I think the not function could handle the issue of your first two routines . ( if I am not mistaken )

Best regards.

---

Well NOT really tharwat ,

The TolayerPC (at post #7) is just fine as it includes user interaction and only once that it will ask for creation of new layer.

As for the 0toPc i removed the (vla-add Layers ...) altogether as it is explicity designed to work only if the layer exists

0toPcM doesnt require the tblsearch condition as it will make the layer regardless it exist or not, and it doesnt really "change" the existing layer properties at all if it does exists.