Check / create layer issue in Lisp

[MarcoW]

I wanted to make a routine that:

1. checks if a linetype is loaded, if not then it should load it, if yes, then okay

2. checks if a layer exists, if not create it (with a specific colour and linetype), if yes, set it current.

This is my code:

 
(defun c:test ( / ltname layname laycol cmdold) ; functie definitie
(setq ltname "center"  ; defines linetypename
 layname "test"   ; defines layername
 laycol 8   ; defines layer color
 cmdold (getvar "cmdecho")
)     ; end setq
(setvar "cmdecho" 0   ; no following by F2
)     ; end setvar
 
(if (= (tblsearch "ltype" ltname) nil)
(command "linetype" "l" ltname "acad.lin" "")
)
(if (= (tblsearch "layer" layname))
(command "layer" "s" layname "")
(command "layer" "m" layname "l" ltname "" "c" laycol "" "")
)
(setvar "cmdecho" cmdold); cmdecho back to what it was
(princ); Exit cleanly
); end of defun

The problem is when the layer exists, it doesn't set it to current...

I'm only 1 inch away from the solution I believe.... but I can't manage to do it.

[Lee Mac]

I have provided a VL option if you wanted to go down that route also:

(defun c:test (/ ltname layname laycol cmdold lay)
  (vl-load-com)
  (setq ltname "center"
        layname "test"
        laycol 8
        cmdold (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)

  ;; Loading Linetype  ~ Another option to consider:

  (if (not (tblsearch "LTYPE" ltname))
    (vla-load
      (vla-get-Linetypes
        (vla-get-ActiveDocument
          (vlax-get-acad-object))) ltname "acad.lin"))

  ;; Layer Checking & Creation

  (if (not (tblsearch "LAYER" layname))
    (command "_.-layer" "_M" layname "_L" ltname layname "_C" laycol layname "")
    (setvar "CLAYER" layname))

  ;; Another Option for Layer Creation to Consider:

  (if (not (tblsearch "LAYER" layname))
    (progn
      (setq lay (vla-add
                  (vla-get-layers
                    (vla-get-ActiveDocument
                      (vlax-get-acad-object))) layname))
      (vla-put-color lay laycol)
      (vla-put-linetype lay ltname)))
  (setvar "CLAYER" layname)

  ;; Reset CMDECHO

  (setvar "CMDECHO" cmdold)
  (princ))

[MarcoW]

Lee,

It works properly allthough i don't get the code. It's too much to get in to that, so let's leave that part for what it is.

This example (test.lsp) is for 1 layer, 1 linetype an 1 colour.
I wonder if it can be made for multiple layers. Not in the way I do it now, thats wrong, defnitly!

I copy the code 10 times and change c:test into c:test1 c:test2 etc. Then per function I modifiy the names.
I wouldn't know how to do it else for test1 calls a specific layer.

[Lee Mac]

The code is not that complicated to explain - I could try to answer any questions you may have about it.

As for multiple layers, colours etc - Make the layer function into a sub-function, and call it with multiple arguments:

(defun mklay (layname laycol ltname / lay)
  (vl-load-com)

  ;; Loading Linetype  ~ Another option to consider:

  (if (not (tblsearch "LTYPE" ltname))
    (vla-load
      (vla-get-Linetypes
        (vla-get-ActiveDocument
          (vlax-get-acad-object))) ltname "acad.lin"))

  ;; Another Option for Layer Creation to Consider:

  (if (not (tblsearch "LAYER" layname))
    (progn
      (setq lay (vla-add
                  (vla-get-layers
                    (vla-get-ActiveDocument
                      (vlax-get-acad-object))) layname))
      (vla-put-color lay laycol)
      (vla-put-linetype lay ltname)))
  (setvar "CLAYER" layname))



(defun c:test ()
  (mapcar 'mklay
          '("test1" "test2" "test3")
          '(8 3 4)
          '("CENTER" "HIDDEN" "CONTINUOUS"))
  (princ))

This will make three layers:

test1 -- colour 8 -- CENTER
test2 -- colour 3 -- HIDDEN
test3 -- colour 4 -- CONTINUOUS

Hope this helps,

Lee

[TimSpangler]

Here is a Linetype loading sub that I use all the time, along with a helper sub.

Just pass it a linetype name and it will search every .lin files in your search path and if it finds it, it gets loaded.

The only thing that I want to do to it, is if a path is supplied than it loads the linetype directly.

[bradb]

Heres one that I use it purges all unused layers then create the 10 layers I use. You can modify the layer names to your liking and at the end of the dolayers command you can modify to set layer current.

(setvar "clayer" "insert layer name here")

I know its rokkie programing but it works for me. I use it to make sure all our drawing have the same layers since I'm the 4th draftsman here we have a lot of different drawings.

Oh and thanks Lee Mac I saw something like this in one of his commands so I just made some mod's to it.

 
(defun createlayer (NAME)
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "CEN" "C" "6" "CEN" "L" "CENTER" "CEN" "LW" "0.18" "CEN" "")
 )
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "DIMS" "C" "1" "DIMS" "LW" "0.18" "DIMS" "")
 )
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "HAT" "C" "3" "HAT" "LW" "0.18" "HAT" "")
 )
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "HID" "C" "4" "HID" "L" "HIDDEN" "HID" "LW" "0.15" "HID" "")
 )
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "LOGO" "C" "176" "LOGO" "LW" "0.09" "" "")
 )
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "OBJ" "C" "2" "OBJ" "LW" "0.40" "OBJ" "")
 )
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "PAPER" "C" "5" "PAPER" "L" "PHANTOM" "PAPER" "P" "N" "PAPER" "")
 )
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "PHAN" "C" "6" "PHAN" "L" "PHANTOM" "PHAN" "LW" "0.18" "PHAN" "")
 )
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "TITLE" "C" "176" "TITLE" "")
 )
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "TXT" "C" "7" "" "")
 )
)

(defun c:dolayers ()
 (setvar "cmdecho" 0)
 (purgelayers)
 (mapcar 'createlayer '("CEN" "DIMS" "HAT" "HID" "LOGO" "OBJ" "PAPER" "PHAN" "TITLE" "TXT"))
)

[Lee Mac]

Heres one that I use it purges all unused layers then create the 10 layers I use. You can modify the layer names to your liking and at the end of the dolayers command you can modify to set layer current.

(setvar "clayer" "insert layer name here")

I know its rokkie programing but it works for me. I use it to make sure all our drawing have the same layers since I'm the 4th draftsman here we have a lot of different drawings.

Oh and thanks Lee Mac I saw something like this in one of his commands so I just made some mod's to it.

 
(defun createlayer (NAME)
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "CEN" "C" "6" "CEN" "L" "CENTER" "CEN" "LW" "0.18" "CEN" "")
 )
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "DIMS" "C" "1" "DIMS" "LW" "0.18" "DIMS" "")
 )
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "HAT" "C" "3" "HAT" "LW" "0.18" "HAT" "")
 )
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "HID" "C" "4" "HID" "L" "HIDDEN" "HID" "LW" "0.15" "HID" "")
 )
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "LOGO" "C" "176" "LOGO" "LW" "0.09" "" "")
 )
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "OBJ" "C" "2" "OBJ" "LW" "0.40" "OBJ" "")
 )
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "PAPER" "C" "5" "PAPER" "L" "PHANTOM" "PAPER" "P" "N" "PAPER" "")
 )
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "PHAN" "C" "6" "PHAN" "L" "PHANTOM" "PHAN" "LW" "0.18" "PHAN" "")
 )
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "TITLE" "C" "176" "TITLE" "")
 )
 (if
  (not (tblsearch "LAYER" NAME))
  (command "-layer" "m" "TXT" "C" "7" "" "")
 )
)

(defun c:dolayers ()
 (setvar "cmdecho" 0)
 (purgelayers)
 (mapcar 'createlayer '("CEN" "DIMS" "HAT" "HID" "LOGO" "OBJ" "PAPER" "PHAN" "TITLE" "TXT"))
)

Bradb,

the way you have called the sub-function, each statement is independent of the argument supplied. I.e. Every IF statement will return T for every single layer that doesnt exist.

[bradb]

Bradb,

the way you have called the sub-function, each statement is independent of the argument supplied. I.e. Every IF statement will return T for every single layer that doesnt exist.

Ah is that because I purged all layers away prior to create layer. I originally wanted it to search for layers then rename them. Ex. search for OBJECT and OBJ. And OBJECT rename to OBJ. And if OBJ then nothing will happen, But if neither exist then create OBJ.

[The Buzzard]

You should do just one tablesearch with an argument and use conditionals to make the layers.

[Lee Mac]

No, it is because you are supplying every IF statement with the same argument.

This is much better (and much faster):

(defun MkLay (Nme Col lTyp lWgt Plt / lay)
  (vl-load-com)
  (setq lay
    (vla-add
      (vla-get-layers
        (vla-get-ActiveDocument
          (vlax-get-acad-object))) Nme))
  (and Col (vla-put-Color lay Col))
  (and lTyp (vla-put-Linetype lay lTyp))
  (and lWgt (vla-put-LineWeight lay lWgt))
  (and (not Plt) (vla-put-Plottable lay :vlax-false)))

(defun c:DoLayers ()
  (purgelayers)
  (mapcar 'MkLay
          '( "CEN"   "DIMS" "HAT"  "HID"   "LOGO" "OBJ"  "PAPER"   "PHAN"   "TITLE" "TXT")  ; Name
          '(   6       1      3      4       176    2       5         6       176     7  )  ; Colours
          '("CENTER"  nil    nil  "HIDDEN"   nil   nil  "PHANTOM" "PHANTOM"   nil    nil )  ; LineType
          '(  0.18   0.18   0.18    0.15    0.09  0.40     nil      0.18      nil    nil )  ; LineWeight
          '(   T       T      T      T        T     T      nil        T        T      T  )) ; Plottable (T or nil)
  (princ))

I'm not sure what your "purgelayers" function does, but maybe I could improve that also