Code Red > AutoLISP (Vanilla / Visual)
Workin' the layers collection yada ...
(1/1)
MP:
--- Code: ---(defun LayMods ( predicateFunction trueFunction elseFunction / foo )
;; trivial code, nonetheless © 2005 Michael Puckett
;; you are free to use in your code, just give a nod
;; to the author and where you found this ;]
;; predicateFunction must take one parameter, a layer
;; object and return a nil or non nil result
;; trueFunction must take one parameter, a layer object;
;; what it actually does is up to the caller. It may be
;; nil if the caller wishes to do nothing when the
;; predicateFunction returns a non nil result.
;; elseFunction must take one parameter, a layer object;
;; what it actually does is up to the caller. It may be
;; nil if the caller wishes to do nothing when the
;; predicateFunction does not return a non nil result.
;; no error trapping is done here in the interests of
;; svelte programming, the caller is responsible for that
(eval
(append
'(defun foo (layer))
(cond
( (and
(eq 'subr (type trueFunction))
(eq 'subr (type elseFunction))
)
'( (if (predicateFunction layer)
(trueFunction layer)
(elseFunction layer)
)
)
)
( (eq 'subr (type trueFunction))
'( (if (predicateFunction layer)
(trueFunction layer)
)
)
)
( (eq 'subr (type elseFunction))
'( (if (null (predicateFunction layer))
(elseFunction layer)
)
)
)
( t
;; apparently caller wants to do nothing
;; via the true or else functions. However,
;; let's assume something is done in the
;; predicate function, and we need to fulfil
;; the contract by applying the predicate
;; function to every layer object
'((predicateFunction layer))
)
)
)
)
(vlax-for layer
(vla-get-layers
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(foo layer)
)
(princ)
)
--- End code ---
Some examples --
Employing a true function only --
--- Code: ---;; lock all layers where the first two characters
;; are the same, like "AA-Concrete" or "BB-Steel",
;; otherwise do nothing
(defun c:NameMePlease ( )
(LayMods
(lambda ( layer / lst )
(eq
(car
(setq lst
(vl-string->list
(strcase
(vla-get-name layer)
)
)
)
)
(cadr lst)
)
)
(lambda ( layer )
(vla-put-lock layer :vlax-true)
)
nil
)
)
--- End code ---
--- Code: ---;; thaw and turn on all layers unconditionally
(defun c:ThawAll ( )
(LayMods
(lambda ( layer ) t)
(lambda ( layer )
(vl-catch-all-apply
'(lambda ()
(vla-put-layeron layer :vlax-true)
(vla-put-freeze layer :vlax-false)
)
)
)
nil
)
)
--- End code ---
Employing true and else functions --
--- Code: ---;; lock all layers where the first two
;; characters are the same, like "AA-Concrete"
;; or ""BB-Steel", otherwise unlock the layer
(defun c:NameMePlease2 ( )
(LayMods
(lambda ( layer / lst )
(eq
(car
(setq lst
(vl-string->list
(strcase
(vla-get-name layer)
)
)
)
)
(cadr lst)
)
)
(lambda ( layer )
(vla-put-lock layer :vlax-true)
)
(lambda ( layer )
(vla-put-lock layer :vlax-false)
)
)
)
--- End code ---
--- Code: ---;; freeze and turn off all xref layers,
;; otherwise thaw and turn on layer
(defun c:XRefsOff ( )
(LayMods
(lambda ( layer )
(wcmatch
(vla-get-name layer)
"*|*"
)
)
(lambda ( layer )
;; error trap an attempt to
;; freeze the current layer
(vl-catch-all-apply
'(lambda ()
(vla-put-layeron layer :vlax-false)
(vla-put-freeze layer :vlax-true)
)
)
)
(lambda ( layer )
(vl-catch-all-apply
'(lambda ()
(vla-put-layeron layer :vlax-true)
(vla-put-freeze layer :vlax-false)
)
)
)
)
)
--- End code ---
Employing an else function only --
--- Code: ---;; isolate the current layer
(defun c:isolate ( / clayer )
(setq clayer (getvar "clayer"))
(LayMods
(lambda ( layer )
;; oh my, using local global
(eq clayer (vla-get-name layer))
)
nil
(lambda ( layer )
(vla-put-layeron layer :vlax-false)
(vla-put-freeze layer :vlax-true)
)
)
)
--- End code ---
Employing neither true or else functions --
--- Code: ---;; print all colors (don't actually do
;; anything to any of the layers)
(defun c:LayColors ( )
(princ "Layer colors:\n")
(LayMods
(lambda ( layer )
(princ
(strcat
(vla-get-name layer)
" => "
(itoa (vla-get-color layer))
"\n"
)
)
)
nil ;; do nothing
nil ;; what ^ said
)
)
--- End code ---
etc.
(I didn't actually test these examples, if you find an insect let me know).
If you're still with me I use this technique at a slightly higher level -- rather than code for a specific collection like the layers collection, I use it for any collection, passing the collection to the overall wrapper --
--- Code: ---(defun ModifyCollection ( collection predicateFunction trueFunction elseFunction )
(eval
(append
'(defun foo (object))
...
)
)
(vlax-for object collection
(foo object)
)
)
--- End code ---
But in the interests of initial clarity I coded it as offered above.
Oops, did I go and share too much info again?
:)
Mark:
The mother lode................. WE'VE STRUCK GOLD BOYS
:)
MP:
Might be considered a load all right ...
:)
Kerry:
Nice Mr P.
Yousa sick puppy.
MP:
Thanks Kerry (I think). :oops:
In the remote chance you're interested ...
--- Code: ---(defun ForEachObject ( collection predfunc thenfunc elsefunc / func )
;; trivial code, nonetheless © 2005 Michael Puckett
;; you are free to use in your code, just give a nod
;; to the author and where you found this ;]
;;
;; the predicate function must take one parameter, an
;; object and return a nil or non nil result
;;
;; the then function must take one parameter, an object;
;; what it actually does is up to the caller. It may
;; be nil if the caller wishes to do nothing when the
;; predicate function returns a non nil result.
;;
;; the else function must take one parameter, an object;
;; what it actually does is up to the caller. It may
;; be nil if the caller wishes to do nothing when the
;; predicate function returns a nil result.
;;
;; no error trapping is done here in the interests of
;; svelte programming, the caller is charged with that
;; resposibility
( (lambda ( then else )
(eval
(append
'(defun func (object))
(cond
( (and then else)
'( (if (predfunc object)
(thenfunc object)
(elsefunc object)
)
)
)
( then
'( (if (predfunc object)
(thenfunc object)
)
)
)
( else
'( (if (null (predfunc object))
(elsefunc object)
)
)
)
( t
'((predfunc object))
)
)
)
)
)
(eq 'subr (type thenfunc))
(eq 'subr (type elsefunc))
)
;; why all the above crud you may ask yourself
;; well ... the above is done only once per
;; call, rather than checking the then and else
;; functions each iteration thru the collection
;; just a wee bit more efficient :]
(vlax-for object collection
(func object)
)
(princ)
)
--- End code ---
Navigation
[0] Message Index
Go to full version