Hi, I'm looking to craft a lisp that will apply a standard set of layer parameters to a file without fully opening it.
Below is a sample of parameters that are applied to an open drawing:
(setq laytemp "E-COMM")(command "layer" "make" laytemp "color" "TRUECOLOR" "124,0,164" laytemp "ltype" "CONDUIT" laytemp "lweight" "0.25" laytemp "plot" "p" laytemp "")
(setq laytemp "E-COMM-MSC")(command "layer" "make" laytemp "color" "TRUECOLOR" "124,0,164" laytemp "ltype" "Continuous" laytemp "lweight" "0.25" laytemp "plot" "p" laytemp "")
(setq laytemp "XE-COMM")(command "layer" "make" laytemp "color" "TRUECOLOR" "124,0,164" laytemp "ltype" "CONDUIT" laytemp "lweight" "0.25" laytemp "plot" "p" laytemp "")
I think that I want to combine a list like this into something with the vla commands. The below is something we have for freezing layers in closed drawings.
(defun c:clof ()
(vl-load-com)
(setq dwgfile (getfiled "Select a drawing" "" "dwg" 0))
(setq lay (getstring "\nENTER A LAYER TO TURN OFF:"))
(setq cadver(substr (getvar "acadver") 1 2)) ;; get cad version No.
(setq id (strcat "objectdbx.AxDbDocument." cadver)) ;; creat prog id
(setq dbx(vlax-create-object id)) ;; creat dbx object
(vla-open dbx dwgfile)
(setq layers (vla-get-layers dbx)) ;; get layer collection set from dbx
(if (not (vl-catch-all-error-p
(setq vlay(vl-catch-all-apply 'vla-item (list layers lay))))) ;; fild the specified layer in collection
(if (eq (vla-get-layeron vlay) :vlax-true) ;; check layer status
(vla-put-layeron vlay :vlax-false)
)
(print "THE LAYER NOT FOUND ! ")
)
(vla-saveas dbx dwgfile)
(vlax-release-object dbx)
(prin1)
)
Can someone help with this, please?
Much thanks!
Solved! Go to Solution.
Solved by paullimapa. Go to Solution.
give this a shot:
; clolyrstd makes standard layers in selected dwg without opening
; response to OP
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/modify-layers-in-closed-files-via-lisp/m-p/11759838#M443852
(defun c:clolyrstd (/ aec_openp dwgfile cadver id dbx layers lay VlMakLyr)
(if(not(car (atoms-family 1 '("vl-load-com"))))(vl-load-com))
;;;--- aec_openp function
; checks to see if file is open already by another program
; returns T if file is opened or read-only
; https://forums.augi.com/showthread.php?6102-Detect-Read-Only-file-attribute&highlight=open
; Usage:
; (aec_openp (strcat(getvar"dwgprefix")(getvar"dwgname")))
; Returns:
; T
; Usage:
; (aec_openp "C:\\Autodesk\\FormIt_English_Win_64bit_dlm\\Setup.exe")
; Returns:
; nil
(defun aec_openp (file-arg / file)
; (setq file (open file-arg "a"))
; (if file (close file))
; file
(cond
((setq file (open file-arg "a"))
(close file)
)
)
(not file)
) ; defun
; VlMakLyr function using vl to create layer with given properties
; Arguments:
; lyrobj = layer object
; name = Layer name
; truecolor = True color values ie '(77 77 77) or '(124 0 164)
; linetype = linetype name
; lineweight = ie 25 = 0.25mm -1 = Bylayer -2 = Byblock -3 = Default
; plot = P = plottable N = Not plottable
; desc = layer description ie "" = blank
(defun VlMakLyr (lyrobj name truecolor linetype lineweight plot desc / acadfil acadlin flg lay lin myColor)
(setq lay (vlax-invoke-method lyrobj 'Add name))
(setq myColor (vla-GetInterfaceObject (vlax-get-acad-object) (strcat"AutoCAD.AcCmColor."(substr(getvar"acadver")1 2))))
(vla-SetRGB myColor (car truecolor) (cadr truecolor) (caddr truecolor))
(vla-put-Truecolor lay myColor)
(if(not(tblsearch "LTYPE" linetype))
(progn
(if(zerop(getvar"measurement"))
(setq acadlin (findfile"acad.lin"))
(setq acadlin (findfile"acadiso.lin"))
)
(setq acadfil (open acadlin "r"))
(while (setq lin (read-line acadfil))
(if (and
(not flg)
(eq (strcat "*" (strcase linetype)) (strcase(substr lin 1 (1+(strlen linetype)))))
)
(progn
(setq flg T)
(vla-load(vla-get-linetypes (vla-get-activedocument (vlax-get-acad-object))) linetype acadlin)
(princ(strcat"\nLinetype [" linetype "] Successfully Loaded."))
) ; progn
) ; if
) ; while
(close acadfil)
) ; progn
) ; if
(if(tblsearch "LTYPE" linetype)
(vlax-put-property lay 'LineType linetype)
(princ(strcat"\nLinetype [" linetype "] Not Loaded... Default to Continuous"))
)
(vlax-put-property lay 'Lineweight lineweight)
(if (= (strcase plot) "P")
(vlax-put-property lay 'Plottable :vlax-true)
(vlax-put-property lay 'Plottable :vlax-false)
)
(vlax-put-property lay 'Description desc)
(princ(strcat"\nLayer Name: [" name "] Successfully Created with Given Properties."))(princ)
) ; defun VlMakLyr
(if(setq dwgfile (getfiled "Select a drawing" "" "dwg" 0))
(if(not(aec_openp dwgfile))
(progn
(setq cadver(substr (getvar "acadver") 1 2)) ;; get cad version No.
(setq id (strcat "objectdbx.AxDbDocument." cadver)) ;; creat prog id
(setq dbx(vlax-create-object id)) ;; creat dbx object
(vla-open dbx dwgfile)
(setq layers (vla-get-layers dbx)) ;; get layer collection set from dbx
; code for layer collection of current dwg
; (setq layers (vlax-get-property (vlax-get-property (vlax-get-acad-object) 'ActiveDocument) 'Layers))
; make layers
(VlMakLyr layers "E-COMM" '(124 0 164) "CONDUIT" 25 "P" "")
(VlMakLyr layers "E-COMM-MSC" '(124 0 164) "Continuous" 25 "P" "")
(VlMakLyr layers "XE-COMM" '(124 0 164) "CONDUIT" 25 "P" "")
(vla-saveas dbx dwgfile)
(vlax-release-object dbx)
(princ(strcat"\nStandard Layers Successfully Created in Drawing: \n\t[" dwgfile "]"))
) ; progn
(princ(strcat"\nSelected Drawing: [" dwgfile "]\n\t is Currently Opened and Cannot be Modified."))
) ; if
(princ"\nNo Drawing Selected.")
) ; if
(prin1)
) ; defun
Just a suggestion replace (VlMakLyr with a foreach layer with the parameters in a list handy if say way more than 3 layers.
Is there a check does layer exist what happens then ? Not tested.
good point...
maybe something like this:
(setq lyrlst
(list
(list "E-COMM" '(124 0 164) "CONDUIT" 25 "P" "")
(list "E-COMM-MSC" '(124 0 164) "Continuous" 25 "P" "")
(list "XE-COMM" '(124 0 164) "CONDUIT" 25 "P" "")
)
)
and then this:
; make layers
(foreach itm lyrlst
(VlMakLyr layers (nth 0 itm) (nth 1 itm) (nth 2 itm) (nth 3 itm) (nth 4 itm) (nth 5 itm))
)
Glad to see suggestion coded, you know what happens next some one else asks how do I set more layers.
o yes bring it on lol
Can't find what you're looking for? Ask the community or share your knowledge.