Help with a lisp

Hi. I need help with a lisp.

This lisp change layer to attribiute blocks.

When the root start ask me to "Specify Layer name :"

All the times i have already create this layer before run this lisp. Is it possible if the lisp can not find this layer to create it automaticaly and then continue

(defun c:chlay (/ ss ly doc)
 ;;    Tharwat 27.May.2014    ;;
 (if (and (/= (setq ly (getstring t "\n Specify Layer name :")) "")
          (if (not (tblsearch "LAYER" ly))
            (progn (alert (strcat "Layer name < " ly " > is not found !!")) nil)
            t
          )
          (princ "\n Select attributed blocks to change layer of Attributes ")
          (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
     )
   (progn (vla-startUndomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
          ((Lambda (i / sn e)
             (while (setq sn (ssname ss (setq i (1+ i))))
               (setq e (tblobjname "BLOCK" (cdr (assoc 2 (entget sn)))))
               (while (setq e (entnext e))
                 (entmod (subst (cons 8 ly) (assoc 8 (entget e)) (entget e))))
               (foreach x (vlax-invoke (vlax-ename->vla-object sn) 'getattributes) (vla-put-layer x ly))
             )
           )
            -1
          )
          (vla-Endundomark doc)
   )
 )
 (princ)
)(vl-load-com)

Thanks

What is the permanent layer name that you want to include in the lisp ?

And what about the color,Ltype, and LineWeight ?

Hi Tharwat .The name of the layer is not standard.It is better to type the name of the layer

And what about the color,Ltype, and LineWeight ?

But the most times the name of the layer is MES with color red and linetype continuous and and LineWeight default

When the root start ask me to "Specify Layer name :"

All the times i have already create this layer before run this lisp. Is it possible if the lisp can not find this layer to create it automaticaly and then continue

 

Hi Tharwat .The name of the layer is not standard.It is better to type the name of the layer

So what's for this thread ?

Tharwat

Quote Originally Posted by prodromosm View Post

When the root start ask me to "Specify Layer name :"

All the times i have already create this layer before run this lisp. Is it possible if the lisp can not find this layer to create it automaticaly and then continue

Quote Originally Posted by prodromosm View Post

Hi Tharwat .The name of the layer is not standard.It is better to type the name of the layer

So what's for this thread ?

Nice !!!!!!!

I don't want to create all the times the layers ... Because the most of the times i run the lisp and then i go back and create the layer and run the lisp again ..... I want if the lisp can not find the layer , dont stop but create it and continue

But the most times the name of the layer is MES with color red and linetype continuous and and LineWeight default

(defun c:chlay  (/ ss doc)
 ;;    Tharwat 11.06.2015    ;;
 (if (not (tblsearch "LAYER" "MES"))
 (entmake (list '(0 . "LAYER")
                '(100 . "AcDbSymbolTableRecord")
                '(100 . "AcDbLayerTableRecord")
                '(2 . "MES")
                '(62 . 1)
                '(6 . "Continuous")
                '(370 . -3)
                '(70 . 0)))
   )
 (princ "\n Select attributed blocks to change layer of Attributes ")
 (if (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
   (progn
     (vla-startUndomark
       (setq doc (vla-get-activedocument (vlax-get-acad-object))))
     ((Lambda (i / sn e)
        (while (setq sn (ssname ss (setq i (1+ i))))
          (setq e (tblobjname "BLOCK" (cdr (assoc 2 (entget sn)))))
          (while (setq e (entnext e))
            (entmod (subst (cons 8 "MES") (assoc 8 (entget e)) (entget e))))
          (foreach x  (vlax-invoke (vlax-ename->vla-object sn) 'getattributes)
            (vla-put-layer x "MES"))
          )
        )
       -1
       )
     (vla-Endundomark doc)
     )
   )
 (princ)
 )(vl-load-com)

We can not change it to something like this ?

(defun c:chlay3  (/ ss doc)
 ;;    Tharwat 11.06.2015    ;;
(if (and (/= (setq ly (getstring t "\n Specify Layer name :")) "")
 (if (not (tblsearch "LAYER" ly))
 (entmake (list '(0 . "LAYER")
                '(100 . "AcDbSymbolTableRecord")
                '(100 . "AcDbLayerTableRecord")
                '(2 . ly )
                '(62 . 1)
                '(6 . "Continuous")
                '(370 . -3)
                '(70 . 0)))
   )
 (princ "\n Select attributed blocks to change layer of Attributes ")
 (if (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
   (progn
     (vla-startUndomark
       (setq doc (vla-get-activedocument (vlax-get-acad-object))))
     ((Lambda (i / sn e)
        (while (setq sn (ssname ss (setq i (1+ i))))
          (setq e (tblobjname "BLOCK" (cdr (assoc 2 (entget sn)))))
          (while (setq e (entnext e))
            (entmod (subst (cons 8 ly) (assoc 8 (entget e)) (entget e))))
          (foreach x  (vlax-invoke (vlax-ename->vla-object sn) 'getattributes)
            (vla-put-layer x ly ))
          )
        )
       -1
       )
     (vla-Endundomark doc)
     )
   )
 (princ)
 )(vl-load-com)

Hi Tharwat . Can you tell me were is the error ?

(defun c:chlay3  (/ ss doc)
 ;;    Tharwat 11.06.2015    ;;
(if (and (/= (setq ly (getstring t "\n Specify Layer name :")) "")
 (if (not (tblsearch "LAYER" ly))
 (entmake (list '(0 . "LAYER")
                '(100 . "AcDbSymbolTableRecord")
                '(100 . "AcDbLayerTableRecord")
                '(2 . ly )
                '(62 . 1)
                '(6 . "Continuous")
                '(370 . -3)
                '(70 . 0)))
   )
 (princ "\n Select attributed blocks to change layer of Attributes ")
 (if (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
   (progn
     (vla-startUndomark
       (setq doc (vla-get-activedocument (vlax-get-acad-object))))
     ((Lambda (i / sn e)
        (while (setq sn (ssname ss (setq i (1+ i))))
          (setq e (tblobjname "BLOCK" (cdr (assoc 2 (entget sn)))))
          (while (setq e (entnext e))
            (entmod (subst (cons 8 ly) (assoc 8 (entget e)) (entget e))))
          (foreach x  (vlax-invoke (vlax-ename->vla-object sn) 'getattributes)
            (vla-put-layer x ly ))
          )
        )
       -1
       )
     (vla-Endundomark doc)
     )
   )
 (princ)
 )(vl-load-com)

Thanks

Hi Tharwat . Can you tell me were is the error ?

 

  
 (if (not (tblsearch "LAYER" ly))
 (entmake (list '(0 . "LAYER")
                '(100 . "AcDbSymbolTableRecord")
                '(100 . "AcDbLayerTableRecord")
                [b][color="red"]'(2 . ly )[/color][/b]
                '(62 . 1)
                '(6 . "Continuous")
                '(370 . -3)
                '(70 . 0)))
   )

 

Thanks

Take a look at: http://www.lee-mac.com/quote.html about when using Apostrophe is ok and when it is not.

Ηι tombu .I can not understand .

I guess that the erros is here

'(2 . ly )

but i don't know how to write it !!!

The value of ly must be evaluated which the quote function does not do so try

(cons 2 ly)

instead.

Not working .Gives me this error

; error: malformed list on input

(defun c:test  (/ ss doc)
 ;;    Tharwat 11.06.2015    ;;
(if (and (/= (setq ly (getstring t "\n Specify Layer name :")) "")
 (if (not (tblsearch "LAYER" ly))
 (entmake (list '(0 . "LAYER")
                '(100 . "AcDbSymbolTableRecord")
                '(100 . "AcDbLayerTableRecord")
                 (cons 2 ly)
                '(62 . 1)
                '(6 . "Continuous")
                '(370 . -3)
                '(70 . 0)))
   )
 (princ "\n Select attributed blocks to change layer of Attributes ")
 (if (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
   (progn
     (vla-startUndomark
       (setq doc (vla-get-activedocument (vlax-get-acad-object))))
     ((Lambda (i / sn e)
        (while (setq sn (ssname ss (setq i (1+ i))))
          (setq e (tblobjname "BLOCK" (cdr (assoc 2 (entget sn)))))
          (while (setq e (entnext e))
            (entmod (subst (cons 8 ly) (assoc 8 (entget e)) (entget e))))
          (foreach x  (vlax-invoke (vlax-ename->vla-object sn) 'getattributes)
            (vla-put-layer x ly ))
          )
        )
       -1
       )
     (vla-Endundomark doc)
     )
   )
 (princ)
 )(vl-load-com)

Try (list ( cons 2 ly))

Given the number of posts I would start to consider setting up a library of defuns like makelay you would save all of these in 1 lisp and auto load at startup this way its available for any routine given the example above.

; save this in the libray lisp
(defun entmaklay (ly / )
(entmake (list '(0 . "LAYER")
                '(100 . "AcDbSymbolTableRecord")
                '(100 . "AcDbLayerTableRecord")
                (cons 2 ly)
                '(62 . 1)
                '(6 . "Continuous")
                '(370 . -3)
                '(70 . 0)))
   )
)

; these 4 lines is all you need in any program now
(if (and (/= (setq ly (getstring t "\n Specify Layer name :")) "")
 (if (not (tblsearch "LAYER" ly))
(entmklay ly)
))

Hi BIGAL. I did the changes but not working ...

  ;;    Tharwat 11.06.2015    ;;
(defun entmaklay (ly / )
(entmake (list '(0 . "LAYER")
                '(100 . "AcDbSymbolTableRecord")
                '(100 . "AcDbLayerTableRecord")
                (list (cons 2 ly))
                '(62 . 1)
                '(6 . "Continuous")
                '(370 . -3)
                '(70 . 0)))
   )
)

(defun c:test  (/ ss doc)
(if (and (/= (setq ly (getstring t "\n Specify Layer name :")) "")
 (if (not (tblsearch "LAYER" ly))
(entmklay ly)
))
 (princ "\n Select attributed blocks to change layer of Attributes ")
 (if (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
   (progn
     (vla-startUndomark
       (setq doc (vla-get-activedocument (vlax-get-acad-object))))
     ((Lambda (i / sn e)
        (while (setq sn (ssname ss (setq i (1+ i))))
          (setq e (tblobjname "BLOCK" (cdr (assoc 2 (entget sn)))))
          (while (setq e (entnext e))
            (entmod (subst (cons 8 ly) (assoc 8 (entget e)) (entget e))))
          (foreach x  (vlax-invoke (vlax-ename->vla-object sn) 'getattributes)
            (vla-put-layer x ly ))
          )
        )
       -1
       )
     (vla-Endundomark doc)
     )
   )
 (princ)
 )(vl-load-com)

Sorry the cons 2 works its in your ly I admit i dont do a lot of error checking take it for granted if some uses lisp they do what it asks.

maybe

if (and (/= (setq ly (getstring "\n Specify Layer name :")) nil)
; mine 
(setq ly (getstring "\n Specify Layer name :")) ; I use a dcl now more often looks nicer and middle of screen.

Now i have this error !!!

; error: no function definition: ENTMKLAY

  ;;    Tharwat 11.06.2015    ;;
(defun c:test  (/ ss doc)
(defun entmaklay (ly / )
(entmake (list '(0 . "LAYER")
                '(100 . "AcDbSymbolTableRecord")
                '(100 . "AcDbLayerTableRecord")
                (list (cons 2 ly))
                '(62 . 1)
                '(6 . "Continuous")
                '(370 . -3)
                '(70 . 0)))
   )
)

(setq ly (getstring "\n Specify Layer name :"))

 (if (not (tblsearch "LAYER" ly))
(entmklay ly)
))
 (princ "\n Select attributed blocks to change layer of Attributes ")
 (if (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
   (progn
     (vla-startUndomark
       (setq doc (vla-get-activedocument (vlax-get-acad-object))))
     ((Lambda (i / sn e)
        (while (setq sn (ssname ss (setq i (1+ i))))
          (setq e (tblobjname "BLOCK" (cdr (assoc 2 (entget sn)))))
          (while (setq e (entnext e))
            (entmod (subst (cons 8 ly) (assoc 8 (entget e)) (entget e))))
          (foreach x  (vlax-invoke (vlax-ename->vla-object sn) 'getattributes)
            (vla-put-layer x ly ))
          )
        )
       -1
       )
     (vla-Endundomark doc)
     )
   )
 (princ)
 )(vl-load-com)

entmaklay entmklay also the idea is to keep the entmakes outside your c:test extras you may like to add entline entarc entaddblock chklay

 ; update 
defun entmaklay (ly / )
(if (not (tblsearch "LAYER" ly))
(entmake (list '(0 . "LAYER")
                '(100 . "AcDbSymbolTableRecord")
                '(100 . "AcDbLayerTableRecord")
                (list (cons 2 ly))
                '(62 . 1)
                '(6 . "Continuous")
                '(370 . -3)
                '(70 . 0)))
   )
)

)

;to use only 1 line required
(entmaklay ly) ; or (entmaklay "ASDF")

here is some sample code from an extensive package written over 20 years ago

(if (= setsc nil)(scaleset))

(setq lay_search wall--3)
(setq lay_colour wall--3col)
(setq l_type wall--3lin)
(lay_miss)
(setq lay_search door--2)
(setq lay_colour door--2col)
(setq l_type door--2lin)
(lay_miss)
(setq lay_search text--2)
(setq lay_colour text--2col)
(setq l_type text--2lin)
(lay_miss)

Try:

 (defun entmaklay (ly / )
(if (not (tblsearch "LAYER" ly))
	(entmake 
	    (list 
		 '(0 . "LAYER")
		 '(100 . "AcDbSymbolTableRecord")
		 '(100 . "AcDbLayerTableRecord")
		 (cons 2 ly)
		 '(62 . 1)
		 '(6 . "Continuous")
		 '(370 . -3)
		 '(70 . 0)
	    )
	)
)
)
(defun c:chlay (/ ss ly doc)
 ;;    Tharwat 27.May.2014    ;;
 (if (and (/= (setq ly (getstring t "\n Specify Layer name :")) "")
          (if (not (tblsearch "LAYER" ly))(entmaklay ly))
          (princ "\n Select attributed blocks to change layer of Attributes ")
          (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
     )
   (progn (vla-startUndomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
          ((Lambda (i / sn e)
             (while (setq sn (ssname ss (setq i (1+ i))))
               (setq e (tblobjname "BLOCK" (cdr (assoc 2 (entget sn)))))
               (while (setq e (entnext e))
                 (entmod (subst (cons 8 ly) (assoc 8 (entget e)) (entget e))))
               (foreach x (vlax-invoke (vlax-ename->vla-object sn) 'getattributes) (vla-put-layer x ly))
             )
           )
            -1
          )
          (vla-Endundomark doc)
   )
 )
 (princ)
)

Thank you tombu ,BIGAL ,Tharwat