Topic: Change layer of all the blocks in the drawing to the layer of block.

[pedroantonio]

Hi. I am searching for a lisp,

 to change layer of all the blocks in the drawing to the layer of block.

[Tharwat]

Hi

Does it mean that you want to change the layer of the objects in all blocks to the layer which each block lay on ?

More information is needed .

[pedroantonio]

For example, I've entered in a drawing 50 blocks. Each block has its own layer. But all the Blocks inserd in layer 0. I need a lisp to
put all blocks  in the drawing to the layer of eatch block .

[CAB]

What defines the layer for each block?

[pedroantonio]

Look the example.dwg

[Tharwat]

Although that it is mixed up with vla but it is cool 

Code - Auto/Visual Lisp: [Select]

1. (defun c:Test (/ *error* l1 l2 s lst i e x en)
2.   ;; Tharwat 02.12.2013 ;;
3.   (or doc
4.       (setq doc (vla-get-activedocument (vlax-get-acad-object)))
5.   )
6.   (defun *error* (u)
7.     (if lst
8.       (mapcar '(lambda (u) (vla-put-lock u :vlax-true)) lst)
9.     )
10.     (princ "\*Cancel*")
11.   )
12.   (setq l1 "Point_dot"
13.         l2 "Station_dot"
14.   )
15.   (if (and (if (tblsearch "LAYER" l1)
16.              t
17.              (progn
18.                (alert (strcat "Layer < " l1 " > is not found !!"))
19.                nil
20.              )
21.            )
22.            (if (tblsearch "LAYER" l2)
23.              t
24.              (progn
25.                (alert (strcat "Layer < " l2 " > is not found !!"))
26.                nil
27.              )
28.            )
29.            (setq s (ssget "_X"
30.                           '((0 . "INSERT") (66 . 1) (2 . "station,point"))
31.                    )
32.            )
33.       )
34.     (progn
35.       (vlax-for layer (vla-get-layers doc)
36.         (if (eq :vlax-true (vla-get-lock layer))
37.           (vla-put-lock (car (setq lst (cons layer lst))) :vlax-false)
38.         )
39.       )
40.       (vla-StartUndoMark doc)
41.       (repeat (setq i (sslength s))
42.         (setq e (entget (setq x (ssname s (setq i (1- i))))))
43.         (entmod (subst (cons 8
44.                              (if (eq (cdr (assoc 2 e)) "point")
45.                                l1
46.                                l2
47.                              )
48.                        )
49.                        (assoc 8 e)
50.                        e
51.                 )
52.         )
53.       )
54.       (vla-EndUndoMark doc)
55.       (if lst
56.         (mapcar '(lambda (u) (vla-put-lock u :vlax-true)) lst)
57.       )
58.       (vla-regen doc AcAllViewports)
59.     )
60.   )
61.   (princ)
62. )
63. (vl-load-com)
64.  

[pedroantonio]

thank you Mr Tharwat for the code but i think that you don't understand exactly my questien.

i want not to change all the attribiuts layers, but to move all blocks to there current layer.For example when i pick the point block not to be in 0 layer but in point_dot layer, when i pick Station block not to be in 0 layer but in Station _dot layer.

[Tharwat]

Hi

So finally , does it mean that you want to put the point in the attributed block to layer Point_dot and the attributed texts to Station_dot ?

[pedroantonio]

yes

[Tharwat]

I updated the previous code , so can you try it and let me know ?

[pedroantonio]

No. look example 2.dwg .I need the inside layer to work. my english is bad.Please try to understand

[Tharwat]

Codes Updated again 

[pedroantonio]

Thank you Tharwat .This  is exactly what I am looking for

[pedroantonio]

i try to add more block in this lisp,and i change the nome of the blocks and i have some error, But i canot understand why?

Code: [Select]

(defun c:Test (/ *error* l1 l2 l3 l4 l5 l6 l7 s lst i e x en)
  ;; Tharwat 02.12.2013 ;;
  (or doc
      (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  )
  (defun *error* (u)
    (if lst
      (mapcar '(lambda (u) (vla-put-lock u :vlax-true)) lst)
    )
    (princ "\*Cancel*")
  )
  (setq l1 "point"
l2 "station"
l3 "trigonom"
l4 "REPERS"
l5 "koryfes"
l6 "kokaek"
l7 "korot"
  )
  (if
    (and
      (if (tblsearch "LAYER" l1)
t
(progn
  (alert (strcat "Layer < " l1 " > is not found !!"))
  nil
)
      )
      (if (tblsearch "LAYER" l2)
t
(progn
  (alert (strcat "Layer < " l2 " > is not found !!"))
  nil
)
(if (tblsearch "LAYER" l3)
  t
  (progn
    (alert (strcat "Layer < " l3 " > is not found !!"))
    nil
  )
  (if (tblsearch "LAYER" l4)
    t
    (progn
      (alert (strcat "Layer < " l4 " > is not found !!"))
      nil
    )
    (if (tblsearch "LAYER" l5)
      t
      (progn
(alert (strcat "Layer < " l5 " > is not found !!"))
nil
      )
      (if (tblsearch "LAYER" l6)
t
(progn
  (alert (strcat "Layer < " l6 " > is not found !!"))
  nil
)
(if (tblsearch "LAYER" l7)
  t
  (progn
    (alert (strcat "Layer < " l7 " > is not found !!"))
    nil
  )
)
(setq s
       (ssget
"_X"
'((0 . "INSERT")
   (66 . 1)
   (2
    .
    "station,point,trigonom,repers,koryfes,kokaek,korot"
   )
  )
       )
)
      )
      (progn
(vlax-for layer (vla-get-layers doc)
  (if (eq :vlax-true (vla-get-lock layer))
    (vla-put-lock
      (car (setq lst (cons layer lst)))
      :vlax-false
    )
  )
)
(vla-StartUndoMark doc)
(repeat (setq i (sslength s))
  (setq e (entget (setq x (ssname s (setq i (1- i))))))
  (entmod
    (subst (cons 8
(if (eq (cdr (assoc 2 e)) "point")
   l1
   l2
   l3
   l4
   l5
   l6
   l7
)
   )
   (assoc 8 e)
   e
    )
  )
)
(vla-EndUndoMark doc)
(if lst
  (mapcar '(lambda (u) (vla-put-lock u :vlax-true)) lst)
)
(vla-regen doc AcAllViewports)
      )
    )
    (princ)
  )
  (vl-load-com)
)
      )
    )
  )
)

[Tharwat]

Try this .

Code - Auto/Visual Lisp: [Select]

1. (defun c:Test (/ *error* l lst lk s i e en ln)
2.   ;; Tharwat 03.12.2013 ;;
3.   (or doc (setq doc (vla-get-activedocument (vlax-get-acad-object))))
4.   (defun *error* (u)
5.     (if lk
6.       (mapcar '(lambda (u) (vla-put-lock u :vlax-true)) lk)
7.     )
8.     (princ "\*Cancel*")
9.   )
10.   (setq lst (mapcar 'strcase (list "point" "station" "trigonom" "REPERS" "koryfes" "kokaek" "korot")))
11.   (mapcar '(lambda (u) (setq l (cons (strcat u ",") l))) lst)
12.   (if (setq s (ssget "_X" (list '(0 . "INSERT") '(66 . 1) (cons 2 (apply 'strcat l)))))
13.     (progn (vlax-for layer (vla-get-layers doc)
14.              (if (eq :vlax-true (vla-get-lock layer))
15.                (vla-put-lock (car (setq lk (cons layer lk))) :vlax-false)
16.              )
17.            )
18.            (vla-StartUndoMark doc)
19.            (repeat (setq i (sslength s))
20.              (setq e (entget (ssname s (setq i (1- i)))))
21.              (if (tblsearch "LAYER" (setq ln (strcase (cdr (assoc 2 e)))))
22.                (entmod (subst (cons 8 (nth (vl-position ln lst) lst)) (assoc 8 e) e))
23.              )
24.            )
25.            (vla-EndUndoMark doc)
26.            (if lk
27.              (mapcar '(lambda (u) (vla-put-lock u :vlax-true)) lk)
28.            )
29.            (vla-regen doc AcAllViewports)
30.     )
31.   )
32.   (princ)
33. )
34. (vl-load-com)
35.