Create new Layers Lisp

[Anonymous]

Hi there,

I have a lisp routine that loads a group of layers based on user input. Unfortunately, it only works once and then if you try load the same group of layers, e.g if the user has accidentally purged a few layers from the original drawing template, it doesn't work, but says "Layer xxx already exists" and then "function cancelled." It then stops loading the remaining layers.

What I would like, is to have the lisp routine (attached) firstly do a search to see whether the layers you're about to load actually exist or not, and if there are some layers from the group the user is trying to load that already exist in the current drawing, I'd like the program to acknowledge this, and continue loading the rest of the layers. That also means that if the entire layer group is already loaded and the user hits that same group by accident, either reload the entire group, or have a msg pop-up to say those layers already do exist, or something to that effect. I hope this all makes sense. Please let me know if it doesn't and I'll try explain it a little better if I can.

I have attached the lisp with the hope that someone can show me where I'm going wrong.

Thanks for your time.

[Anonymous]

In block editor you have to create a attribute defination name in different layer , it means in block editor you'll get tow layers ,one of them is block layer and another is the attribute layer , when you finish'd and save the editor it have come for all the blocks.

that would be a helpfull lispevr for me..

[miroko]

Hello

I see that this is already marked as solved but still like to show my own method to do that.

It is actually very simple and without lisp (we have also AutoCAD LT in office therefore had to find way to do that also for LT).

First I created a file with all the layers (it is basically copy of original template file just without any objects drawn in it, but only layers are defined in this file - all other objects purged).

Then I use following script with name of file 'Standard_Layers.scr':

begining of script

-insert
"F:\Autocad Blocks\Standard_Layers.dwg"
0,0

xplode
l

e
-purge
b
LMG_GA_Standard_Layers
n

end of script - important to have this 'enter' above (ampty line), it makes finishing function

And in AutoCAD I create button with macro:

^C^C_'script;"F:/AutoCAD/Templates/Standard_Layers.scr"

this is where script is located

And just click on the button and all layers are back.

As you can see it is inserting the template drawing into the file (as block), then exploding it and purging away the inserted block (leaving layers definition in file).

regards

miroko

[H_franco]

how about looking for different linetypes.... 

example: get linetype from either acad.lin, b.lin, c.lin, etc...

would replacing

(vla-load 
	   (vla-Get-Linetypes doc) (nth 2 x) "acad.lin")
		  )

with this instead?

  (if
        (and
            (setq lin (findfile lin))
            (setq lin (open lin "r"))
        )
        (progn
            (setq ltp (strcat "`*" (strcase ltp) "`,*"))
            (while
                (and (setq str (read-line lin))
                     (not (setq rtn (wcmatch (strcase str) ltp)))
                )
            )

 or something similar? could that work?

[Sea-Haven]

maybe something like this

(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(defun loadLinetype (LineTypeName FileName)
  (if (and
        (not (existLinetype doc LineTypeName))
        (vl-catch-all-error-p
          (vl-catch-all-apply
            'vla-load
            (list
              (vla-get-Linetypes doc)
              LineTypeName
              FileName
            )
          )
        )
      )
    nil
    T
  )
)

(defun existLinetype (LineTypeName / item loaded)
  (vlax-for item (vla-get-linetypes doc)
    (if (= (strcase (vla-get-name item)) (strcase LineTypeName))
      (setq loaded T)
    )
  )
)

;load missing linetypes
;;; returns: T if loaded else nil
(loadLinetype "Fence" "custom.lin")
(loadLinetype "Tree" "custom.lin")

M

[diagodose2009]

#region
(defun CLAYEW (/ LayerIdst $rr)
/*c2s: setvar("cmdecho",0);
       LayerIds=list(lISt("CE-PAD-BNDY",2,"HIDDEN2","EARTHWORKS : PAD BOUNDARY"),
                list("CE-PAD-LEVL",1,"CONTINUOUS","EARTHWORKS : PAD LEVEL"),
                list("CE-FILL-LINE",253,"CONTINUOUS","EARTHWORKS : FILL TO EXTENTS LINE"),
                list("CE-HTCH",35,"DASHDOT2","EARTHWORKS "));
        ProcessLayers(LayerIds);
        Alert("Civil EARTHWORKS layers have been added successfully!");
        Setvar("cmdecho",1);
        Setvar("clayer","0");
*/
$rr)
;;Title=""Create new Layers Lisp""
(Defun ProcessLayers(LayerList / doc LayerCollection x clc rol rcr)
/*c2s: vl.load_com();
       oc=vla.get_activedocument(vlax.get_acad_object());
       LayerCollection=vla.get_layers(doc);
       foreach(x,LayerList,
             newlayer=vla.add(LayerCollection,nth(0,x)),
             clc=vla.put_color(NewLayer,nth(1,x)),
             rol= (!tblobjname("ltype",nth(2,x)))?vla.load(vla.get_linetypes(doc),
			       nth(2,x),"acad.lin"):nil,
             rcr=vla.put_linetype(NewLayer,nth(2,x)),
             rcr=vla.put_description(NewLayer,nth(3,x)));
*/
LayerList)
#endregion

[H_franco]

here is the overall part of the routine, 

; CREATE ALL LAYERS AND ASSIGN COLOR, LINETYPE AND DESCRIPTION.
(mapcar '(lambda (x)
	    (setq NewLayer (vla-add LayerCollection (nth 0 x)
			   )
	    )
	    (vla-put-color NewLayer (nth 1 x)
	    )
	       (if 
	          (not 
		     (tblobjname "ltype" (nth 2 x)
	          )
	       )
(vla-load
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(defun loadLinetype (LineTypeName FileName)
  (if (and
        (not (existLinetype doc LineTypeName))
        (vl-catch-all-error-p
          (vl-catch-all-apply
            'vla-load
            (list
              (vla-get-Linetypes doc)
              LineTypeName
              FileName
            )
          )
        )
      )
    nil
    T
  )
))

(defun existLinetype (LineTypeName / item loaded)
  (vlax-for item (vla-get-linetypes doc)
    (if (= (strcase (vla-get-name item)) (strcase LineTypeName))
      (setq loaded T)
    )
  )
)
)
;load missing linetypes
;;; returns: T if loaded else nil
(loadLinetype "palm" "sample.lin")
(loadLinetype "tree" "sample.lin")
)
	     (vla-put-linetype NewLayer (nth 2 x)
		     )
			(vla-put-Description NewLayer (nth 3 x)
			)
	 ); _end lambda
   LayerList
); _end mapcar

 but unfortunately I'm still getting an error. X_X