Check / create layer issue in Lisp

[bradb]

OK, this should work:

 

[b][color=red]([/color][/b][b][color=blue]defun[/color][/b] MkLay [b][color=red]([/color][/b]Nme Col lTyp lWgt Plt [b][color=blue]/[/color][/b] lay[b][color=red])[/color][/b]
 [b][color=red]([/color][/b][b][color=blue]vl-load-com[/color][/b][b][color=red])[/color][/b]
 [b][color=red]([/color][/b][b][color=blue]setq[/color][/b] lay
   [b][color=red]([/color][/b][b][color=blue]vla-add[/color][/b]
     [b][color=red]([/color][/b][b][color=blue]vla-get-layers[/color][/b]
       [b][color=red]([/color][/b][b][color=blue]vla-get-ActiveDocument[/color][/b]
         [b][color=red]([/color][/b][b][color=blue]vlax-get-acad-object[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b] Nme[b][color=red])[/color][/b][b][color=red])[/color][/b]
 [b][color=red]([/color][/b][b][color=blue]and[/color][/b] Col [b][color=red]([/color][/b][b][color=blue]vla-put-Color[/color][/b] lay Col[b][color=red])[/color][/b][b][color=red])[/color][/b]
 [b][color=red]([/color][/b][b][color=blue]and[/color][/b] lTyp [b][color=red]([/color][/b]lTload lTyp[b][color=red])[/color][/b] [b][color=red]([/color][/b][b][color=blue]vla-put-Linetype[/color][/b] lay lTyp[b][color=red])[/color][/b][b][color=red])[/color][/b]
 [b][color=red]([/color][/b][b][color=blue]and[/color][/b] lWgt  [b][color=red]([/color][/b][b][color=blue]vla-put-LineWeight[/color][/b] lay [b][color=red]([/color][/b][b][color=blue]eval[/color][/b] [b][color=red]([/color][/b][b][color=blue]read[/color][/b] [b][color=red]([/color][/b][b][color=blue]strcat[/color][/b] [b][color=#ff00ff]"acLnWt"[/color][/b] lWgt[b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
 [b][color=red]([/color][/b][b][color=blue]and[/color][/b] [b][color=red]([/color][/b][b][color=blue]not[/color][/b] Plt[b][color=red])[/color][/b] [b][color=red]([/color][/b][b][color=blue]vla-put-Plottable[/color][/b] lay :vlax-false[b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]

[b][color=red]([/color][/b][b][color=blue]defun[/color][/b] lTload [b][color=red]([/color][/b]lTyp[b][color=red])[/color][/b]
 [b][color=red]([/color][/b][b][color=blue]or[/color][/b] [b][color=red]([/color][/b][b][color=blue]tblsearch[/color][/b] [b][color=#ff00ff]"LTYPE"[/color][/b] lTyp[b][color=red])[/color][/b]
     [b][color=red]([/color][/b][b][color=blue]vla-load[/color][/b]
       [b][color=red]([/color][/b][b][color=blue]vla-get-Linetypes[/color][/b]
         [b][color=red]([/color][/b][b][color=blue]vla-get-ActiveDocument[/color][/b]
           [b][color=red]([/color][/b][b][color=blue]vlax-get-acad-object[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b] lTyp [b][color=#ff00ff]"acad.lin"[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
 [b][color=blue]t[/color][/b][b][color=red])[/color][/b]


[b][color=red]([/color][/b][b][color=blue]defun[/color][/b] c:DoLayers [b][color=red]([/color][/b][b][color=blue]/[/color][/b] cm[b][color=red])[/color][/b]
 [b][color=red]([/color][/b][b][color=blue]vl-load-com[/color][/b][b][color=red])[/color][/b]
 [b][color=red]([/color][/b][b][color=blue]setq[/color][/b] cm [b][color=red]([/color][/b][b][color=blue]getvar[/color][/b] [b][color=#ff00ff]"CMDECHO"[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
 [b][color=red]([/color][/b][b][color=blue]setvar[/color][/b] [b][color=#ff00ff]"CMDECHO"[/color][/b] [b][color=#009900]0[/color][/b][b][color=red])[/color][/b]
 [b][color=red]([/color][/b][b][color=blue]vl-cmdf[/color][/b] [b][color=#ff00ff]"_.-purge"[/color][/b] [b][color=#ff00ff]"_LA"[/color][/b] [b][color=#ff00ff]"*"[/color][/b] [b][color=#ff00ff]"_N"[/color][/b][b][color=red])[/color][/b]

 [b][color=red]([/color][/b][b][color=blue]mapcar[/color][/b] [b][color=darkred]'[/color][/b]MkLay

         [b][color=darkred]'[/color][/b][b][color=red]([/color][/b] [b][color=#ff00ff]"CEN"[/color][/b]   [b][color=#ff00ff]"DIMS"[/color][/b] [b][color=#ff00ff]"HAT"[/color][/b]  [b][color=#ff00ff]"HID"[/color][/b]   [b][color=#ff00ff]"LOGO"[/color][/b] [b][color=#ff00ff]"OBJ"[/color][/b]  [b][color=#ff00ff]"PAPER"[/color][/b]   [b][color=#ff00ff]"PHAN"[/color][/b]   [b][color=#ff00ff]"TITLE"[/color][/b] [b][color=#ff00ff]"TXT"[/color][/b][b][color=red])[/color][/b]  [i][color=#990099]; Name [str][/color][/i]
         [b][color=darkred]'[/color][/b][b][color=red]([/color][/b]   [b][color=#009900]6[/color][/b]       [b][color=#009900]1[/color][/b]      [b][color=#009900]3[/color][/b]      [b][color=#009900]4[/color][/b]       [b][color=#009900]176[/color][/b]    [b][color=#009900]2[/color][/b]       [b][color=#009900]5[/color][/b]         [b][color=#009900]6[/color][/b]       [b][color=#009900]176[/color][/b]     [b][color=#009900]7[/color][/b]  [b][color=red])[/color][/b]  [i][color=#990099]; Colours [int][/color][/i]
         [b][color=darkred]'[/color][/b][b][color=red]([/color][/b][b][color=#ff00ff]"CENTER"[/color][/b]  [b][color=blue]nil[/color][/b]    [b][color=blue]nil[/color][/b]  [b][color=#ff00ff]"HIDDEN"[/color][/b]   [b][color=blue]nil[/color][/b]   [b][color=blue]nil[/color][/b]  [b][color=#ff00ff]"PHANTOM"[/color][/b] [b][color=#ff00ff]"PHANTOM"[/color][/b]   [b][color=blue]nil[/color][/b]    [b][color=blue]nil[/color][/b] [b][color=red])[/color][/b]  [i][color=#990099]; LineType [str][/color][/i]
         [b][color=darkred]'[/color][/b][b][color=red]([/color][/b] [b][color=#ff00ff]"018"[/color][/b]   [b][color=#ff00ff]"018"[/color][/b]  [b][color=#ff00ff]"018"[/color][/b]  [b][color=#ff00ff]"015"[/color][/b]    [b][color=#ff00ff]"009"[/color][/b] [b][color=#ff00ff]"040"[/color][/b]    [b][color=blue]nil[/color][/b]      [b][color=#ff00ff]"018"[/color][/b]     [b][color=blue]nil[/color][/b]    [b][color=blue]nil[/color][/b] [b][color=red])[/color][/b]  [i][color=#990099]; LineWeight [str] 0.18 = "018"[/color][/i]
         [b][color=darkred]'[/color][/b][b][color=red]([/color][/b]   [b][color=blue]T[/color][/b]       [b][color=blue]T[/color][/b]      [b][color=blue]T[/color][/b]      [b][color=blue]T[/color][/b]        [b][color=blue]T[/color][/b]     [b][color=blue]T[/color][/b]      [b][color=blue]nil[/color][/b]        [b][color=blue]T[/color][/b]        [b][color=blue]T[/color][/b]      [b][color=blue]T[/color][/b]  [b][color=red])[/color][/b][b][color=red])[/color][/b] [i][color=#990099]; Plottable (T or nil)[/color][/i]

 [b][color=red]([/color][/b][b][color=blue]setvar[/color][/b] [b][color=#ff00ff]"CMDECHO"[/color][/b] cm[b][color=red])[/color][/b]
 [b][color=red]([/color][/b][b][color=blue]princ[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]

 

Ok this maybe a stupid question but int the defun ltload you have a t) at the close what is the t doing

[Lee Mac]

Ok this maybe a stupid question but int the defun ltload you have a t) at the close what is the t doing

 

OK, that T probably doesnt necessary need to be there, - I included it when I was testing the function.

 

But the OR statement inside the function would return T anyway.

 

I need a return of T as I am including it in an AND statement in the other function.

[Lee Mac]

I don't think you need it:

 

(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 (lTload lTyp) (vla-put-Linetype lay lTyp))
 (and lWgt  (vla-put-LineWeight lay (eval (read (strcat "acLnWt" lWgt)))))
 (and (not Plt) (vla-put-Plottable lay :vlax-false)))

(defun lTload (lTyp)
 (or (tblsearch "LTYPE" lTyp)
     (vla-load
       (vla-get-Linetypes
         (vla-get-ActiveDocument
           (vlax-get-acad-object))) lTyp "acad.lin")))


(defun c:DoLayers (/ cm)
 (vl-load-com)
 (setq cm (getvar "CMDECHO"))
 (setvar "CMDECHO" 0)
 (vl-cmdf "_.-purge" "_LA" "*" "_N")
 
 (mapcar 'MkLay
         
         '( "CEN"   "DIMS" "HAT"  "HID"   "LOGO" "OBJ"  "PAPER"   "PHAN"   "TITLE" "TXT")  ; Name [str]
         '(   6       1      3      4       176    2       5         6       176     7  )  ; Colours [int]
         '("CENTER"  nil    nil  "HIDDEN"   nil   nil  "PHANTOM" "PHANTOM"   nil    nil )  ; LineType [str]
         '( "018"   "018"  "018"  "015"    "009" "040"    nil      "018"     nil    nil )  ; LineWeight [str] 0.18 = "018"
         '(   T       T      T      T        T     T      nil        T        T      T  )) ; Plottable (T or nil)
 
 (setvar "CMDECHO" cm)
 (princ))

[bradb]

OK, that T probably doesnt necessary need to be there, - I included it when I was testing the function.

 

But the OR statement inside the function would return T anyway.

 

I need a return of T as I am including it in an AND statement in the other function.

 

 

No problem just trying to learn

[Lee Mac]

No problem just trying to learn

 

Yes, I admire you for that - and ask any question you may have about any of the code I have posted

[TimSpangler]

Just a side note for those looking / learning new things. I used to use a bunch of lisp files that created layers inside of there respective functions, but I found that if a layer color needs to changed then I have to go into a couple of programs to make that change.

 

Soooo.

 

I adopted a new approach to layer creation. It started with the LayerCreator, which uses text based files for the layer properties then creates the layers based on that. (see example of a layer file below):

 

A-FRAM-ANNO;Framing Plan - Text and callouts with associated leaders;Continuous;25;4;1;Design Solutions;Thin;
A-FRAM-DIMS;Framing Plan - Extension lines, dimension terminators, dimension text;Continuous;15;3;1;Design Solutions;Fine;
A-FRAM-PATT;Framing Plan - Textures and hatch patterns;Continuous;05;253;1;Design Solutions;Xtra Fine;
A-FRAM-NPLT;Framing Plan - Non-plotting graphic information;Continuous;25;6;0;Design Solutions;Thin;
A-FRAM-SCHD;Framing Plan - Framing plan shedule objects;Continuous;25;7;1;Design Solutions;Thin;

 

Then all i need to do is call the layer creation program:

 

;;; ------------------------------------------------------------------------
;;;    STDLIB_ADD_LAYER.LSP
;;;
;;;    Copyright © December, 2008
;;;    Timothy G. Spangler
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    STDLIB_ADD_LAYER
;;;
;;;		 Description:
;;;
;;;		* (STDLIB_ADD_LAYER "A-FLOR-ANNO" T)
;;;		<LAYERNAME>	=	STRING	=	Valid layer name found in in a lyr file
;;;		<CURRENT>			=	BOOLE	=	If T then it set the created layer current
;;;
;;;			Returns:
;;;				String= Layer Name of added layer if succesfull
;;;
;;; ------------------------------------------------------------------------

;;; MAIN FUNCTION ;;;;;;;;;;;;;;;;;;;;;;;;;
(defun STDLIB_ADD_LAYER (LayerName Current / LayerFilesPath LayerFilesList LayerLine LayerName)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SUB TO FIND FOR THE LAYER FILES PATH
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun CHECK_LAYER_FILES (/ NewPath Found)
	;; Check each search path for a Layer Files Folder
	(foreach X (STR->LIST (getenv "ACAD") ";")
		(setq NewPath (strcat X "\\Layer Files"))
		(if (vl-file-directory-p NewPath)
			(setq Found NewPath)
		)
	)
	Found
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SUB TO GET A LIST OF LAYER FILES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun GET_LAYER_FILES (Path / TmpLineFiles LineFiles)
	(setq TmpLineFiles (vl-directory-files Path "*.lyr"))
	(foreach X TmpLineFiles
		(setq LineFiles (cons (strcat Path "\\" X) LineFiles))
	)
	LineFiles
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SUB TO RETURN LAYER INFORMATION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun FIND_LAYER_FILE (Layer FileList / OpenFile CurrentLine LayerInfo)		
	;; Read each line file found and check for the linetype
	(foreach X FileList
		(setq OpenFile (open X "r"))
		(while (setq CurrentLine (read-line OpenFile))
			(if (wcmatch (strcase CurrentLine) (strcat "*" (strcase Layer) ";*"))
				(progn
					(setq LayerInfo CurrentLine)
				)
			)
		)
		(close OpenFile)
	)
	LayerInfo
)

;; Check if layer exsists
(if (not (tblsearch "LAYER" LayerName))
	(progn
		;; Set Layer files path
		(setq LayerFilesPath (CHECK_LAYER_FILES))
		;; Get list of Layer Files
		(if LayerFilesPath
			(setq LayerFilesList (GET_LAYER_FILES LayerFilesPath))
		)
		;; Get a list of layer information
		(setq LayerLine (FIND_LAYER_FILE LayerName LayerFilesList))			
		(if LayerLine
			(progn
				(setq LayerLine(STR->LIST LayerLine ";"))
				(setq LayerName (nth 0 layerLine))
				(STDLIB_CREATE_LAYER (nth 0 LayerLine)(nth 1 LayerLine)(nth 2 LayerLine)(nth 3 LayerLine)(nth 4 LayerLine)(nth 5 LayerLine) nil)
			)
			(setq LayerName "0")
		)
	)
	(setq LayerName LayerName)
)
;; Make current
(if Current
	(setvar "CLAYER" Layername)
)
LayerName
)
(princ)

*** There are some helper functions that go along with this, if anyone is interested ***

 

What this does is creates one location to change any layer property. I call this before inserting blocks, etc.

 

Just some food for thought, If anyone wants more insight into the process or has any thoughts I'd be more than willing to hear them.