Author Topic: Workin' the layers collection yada ...  (Read 2930 times)

0 Members and 1 Guest are viewing this topic.

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Workin' the layers collection yada ...
« on: April 14, 2005, 03:52:41 PM »
Code: [Select]
(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)

)

Some examples --

Employing a true function only --

Code: [Select]
;;  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

    )
   
)

Code: [Select]
;;  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

    )
)

Employing true and else functions --

Code: [Select]
;;  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)
        )

    )
   
)

Code: [Select]
;;  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)
                )
            )
        )
       
    )    

)

Employing an else function only --

Code: [Select]
;;  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)
        )
    )
)

Employing neither true or else functions --

Code: [Select]
;;  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

    )
)


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: [Select]
(defun ModifyCollection ( collection predicateFunction trueFunction elseFunction )

    (eval
        (append
           '(defun foo (object))
            ...
        )
    )
   
    (vlax-for object collection
        (foo object)
    )            

)

But in the interests of initial clarity I coded it as offered above.

Oops, did I go and share too much info again?

:)
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

Mark

  • Custom Title
  • Seagull
  • Posts: 28762
Workin' the layers collection yada ...
« Reply #1 on: April 14, 2005, 05:04:02 PM »
The mother lode................. WE'VE STRUCK GOLD BOYS

:)
TheSwamp.org  (serving the CAD community since 2003)

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Workin' the layers collection yada ...
« Reply #2 on: April 14, 2005, 05:49:30 PM »
Might be considered a load all right ...

:)
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Workin' the layers collection yada ...
« Reply #3 on: April 14, 2005, 07:25:42 PM »
Nice Mr P.

Yousa sick puppy.
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Workin' the layers collection yada ...
« Reply #4 on: April 14, 2005, 08:21:53 PM »
Thanks Kerry (I think). :oops:

In the remote chance you're interested ...

Code: [Select]
(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)

)
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst