TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: nivuahc on December 01, 2005, 09:23:54 AM
-
There's got to be a better way
I posted a tiny bit of code in this thread (http://www.theswamp.org/forum/index.php?topic=7872.0) earlier today that I threw together yesterday when my brain took a detour from work for a bit. Anyway, I threw it together because I wanted to refresh my mind a bit when it comes to building lists and processing them (I haven't written any code in forever and I have a framework of an idea for a routine, this being part of it).
Anyway, what I actually wanted to do was build a list of layers that I could parse through and this is what I came up with:
;*********************************************************************************
; Function to build a list of available layers - © Copyright 2005 by Chuck Chauvin
;*********************************************************************************
(defun BuildLayerList (/ LayerItem)
(setq LayerList nil)
(setq LayerItem (tblnext "LAYER" T))
(while (/= LayerItem nil)
(setq LayerList
(append LayerList
(list
(list
(cdr (assoc 2 LayerItem)) ;; Name
(cdr (assoc 62 LayerItem)) ;; Color
(cdr (assoc 6 LayerItem)) ;; Linetype
) ;_end list
) ;_end list
) ;_end append
) ;_end setq LayerList
(setq LayerItem (tblnext "LAYER"))
) ;_end while
(princ)
) ;_end defun BuildLayerList
This started out as me thinking "build a list of layers that are in the drawing along with their linetypes". That was simple enough to do but, along the way I thought "well, maybe I'll want to throw the color in there as well" so I added that bit as an afterthought. Anyway, the above code will build a list that looks like this:
(("0" 7 "Continuous") ("LAYER_1" 7 "Continuous") ("LAYER_2" 5 "Dashed") ("LAYER_3" 150 "Hidden"))
that I can then use later on, in this skeleton of a routine I've got floating around in my skull.
Anyway, my gut tells me this isn't the most efficient way (with LISP) to do this and I was wondering if anyone had any thoughts or suggestions (using LISP) to make this better.
-
Chuck, Thats about as efficient as you'll get .. if you consider return on investment, and if you're not chasing milliseconds.
I have a similar functionality using Vlisp which grabs the Layers Collection and iterates it collecting the properties from each Layer object, including some status info. I doubt it is much faster or slower than yours.
-
That's what I would use
(defun BuildLayerList ( / LayerItem LayerList)
(while (setq LayerItem (tblnext "LAYER" (not LayerItem)))
(setq LayerList
(cons
(list
(cdr (assoc 2 LayerItem)) ;; Name
(cdr (assoc 62 LayerItem)) ;; Color
(cdr (assoc 6 LayerItem)) ;; Linetype
) ;_end list
LayerList
) ;_end append
) ;_end setq LayerList
) ;_end while
(reverse LayerList)
) ;_end defun BuildLayerList
Using 'cons' instead of 'append' is remarkable faster... and 'tblnext' can be controlled by his return value. Note, the LayerList variable isn't anymore global. The function returns the value now, strictly speaking the correct way to program sub's.
Cheers :-)
-
(defun ForFun ( / data result )
(while (setq data (tblnext "layer" (null data)))
(setq result
(cons
(mapcar
'(lambda (key) (cdr (assoc key data)))
'(2 62 6)
)
result
)
)
)
)
-
One other wrinkle if you work ObjectDBX and this is a toolbox function. It may make sense to pass the document as an argument. This way the function isn't limited to the active document.
This version filters out xref layers. but you get my drift.
(defun GetLayers ( doc / layers layname laylst )
(setq layers (vla-get-Layers doc))
(vlax-for x layers
(setq layname (vlax-get x 'Name))
;filter out xref layers
(if (not (vl-string-search "|" layname))
(setq laylst (cons layname laylst))
)
)
(acad_strlsort laylst)
) ;end
-
If you want the same data via an activex route (including objectdbx) ...
(defun ForFun2 ( document / result )
(vlax-for layer (vla-get-layers document)
( (lambda (data)
(setq result
(cons
(mapcar
'(lambda (key) (cdr (assoc key data)))
'(2 62 6)
)
result
)
)
)
(entget (vlax-vla-object->ename layer))
)
)
)
:)
-
OT: It's really good to see you posting again Chuck.
-
OT: It's really good to see you posting again Chuck.
thankee :)
-
And for completeness ...
(defun ForFun3 ( document / result )
(vlax-for layer (vla-get-layers document)
(setq result
(cons
(mapcar
'(lambda (property) (vlax-get layer property))
'(name color linetype)
)
result
)
)
)
)
:)
-
.. As I said Chuck, depends if you're chasing milliseconds. Yours is still firmly in the running.
160 cycles per second <256 in 1.6> is pretty good.
Benchmarking [M.P. 2005] ...........Elapsed milliseconds for 256 iteration(s)/ relative Timing :
(FORFUN3 KBSG:ACTIVEDOC)..........2113 / 1.4068 <slowest>
(GETLAYERS_XX KBSG:ACTIVEDOC).....1913 / 1.2736
(FORFUN)..........................1742 / 1.1598
(BUILDLAYERLIST)..................1622 / 1.0799
(BUILDLAYERLIST_JM)...............1512 / 1.0067
(FORFUN2 KBSG:ACTIVEDOC)..........1502 / 1 <fastest>
This is a variation on the ActiveX method included.
(defun GetLayers_xx (document / laylst)
(vlax-for each (vla-get-layers document)
(setq laylst (cons (list (vlax-get each 'Name)
(vlax-get each 'Color)
(vlax-get each 'LineType)
)
laylst
)
)
)
)
PS:
I've excluded Joe's from the test because the functionality is different
-
... and to put Kerry's comments into perspective ... in a drawing with 1000 layers the delay is imperceptable (~ 60 milliseconds) with the slowest function in the lot; with 10000 layers it's still under 1 second (~ 680 milliseconds). (WXPP, P4, 3GHz, 1 GB RAM).
:)
-
Nice examples of looping & collecting table data.
Thanks Fellas.
-
(defun test6 (i)
(if (setq i (tblnext "LAYER" (not i)))
(cons
(mapcar '(lambda (x) (cdr (assoc x i))) '(2 62 6))
(test6 t)
) ;_ cons
) ;_ if
)
_$
Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s):
(TEST6 nil)..............1047 / 14.45 <fastest>
(GETLAYERS DOC)..........6969 / 2.17
(FORFUN2 DOC)............7890 / 1.92
(BUILDLAYERLIST_JM)......8453 / 1.79
(BUILDLAYERLIST).........8563 / 1.77
(FORFUN).................8937 / 1.69
(GETLAYERS_XX DOC)......14546 / 1.04
(FORFUN3 DOC)...........15125 / 1 <slowest>
_$
-
(defun test6 (i)
(if (setq i (tblnext "LAYER" (not i)))
(cons
(mapcar '(lambda (x) (cdr (assoc x i))) '(2 62 6))
(test6 t)
) ;_ cons
) ;_ if
)
(test6 nil) vs (test6 t) makes a big difference eh?
:)
-
I apologize, I have made a mistake, wanted it to corrected but have made even more!
(defun test7 (i)
(if (setq i (tblnext "LAYER" i))
(cons
(list
(cdadr i)
(cdr(cadddr i))
(cdar(cddddr i))
) ;_ mapcar
(test7 nil)
) ;_ cons
) ;_ if
)
Benchmarking .............Elapsed milliseconds / relative speed for 1024 iteration(s):
(FORFUN2 DOC)...........1797 / 1.98 <fastest>
(TEST7 T)...............1937 / 1.84
(BUILDLAYERLIST_JM).....1984 / 1.8
(BUILDLAYERLIST)........2000 / 1.78
(FORFUN)................2094 / 1.7
(GETLAYERS_XX DOC)......3359 / 1.06
(FORFUN3 DOC)...........3562 / 1 <slowest>
-
Okay guys, remember us slow folks are still around, and had I known I'd have needed those brain cells, I'd have been kinder to 'em in my youth. Michael, when you have time, could you spread out FORFUN with a little explanation for me. I'm trying to reach around it and get a grip on it for application. :|
-
Does this help?
(defun ForFun ( / data result )
(while (setq data (tblnext "layer" (null data)))
;; tblnext when used this way, with the `data' var not valid,
;; {the var has not been initialized yet so `(nul nil) will return `T}
;; will retrieve the first entity in the database.
;; so this loop will continue thru the entire dwg database.
(setq result
(cons
(mapcar
'(lambda (key) (cdr (assoc key data)))
'(2 62 6)
)
result
)
)
)
)
Does that help?
-
How about this Chuck, does this illuminate the underpinnings?
(defun c:sample ( / foo data keys )
(defun foo ( data keys / result )
;; the core algorythm
(setq result
(mapcar
'(lambda (key) (cdr (assoc key data)))
keys
)
)
;; print out the original data
(princ
(strcat
"Data = "
(vl-prin1-to-string data)
"\n"
)
)
;; print out the keys used to filter the data
(princ
(strcat
"Keys = "
(vl-prin1-to-string keys)
"\n"
)
)
;; print out the filtered data
(princ
(strcat
"Filtered data = "
(vl-prin1-to-string result)
"\n\n"
)
)
)
;; set up some simple data
(setq data
'(
(1 . "Chuck")
(2 . "John")
(3 . "Mark")
(4 . "Michael")
(5 . "Randy")
)
)
;; now filter using different keys
(foo data '(1))
(foo data '(1 2 3))
(foo data '(1 3 5))
(princ)
)
Output --
Data = ((1 . "Chuck") (2 . "John") (3 . "Mark") (4 . "Michael") (5 . "Randy"))
Keys = (1)
Filtered data = ("Chuck")
Data = ((1 . "Chuck") (2 . "John") (3 . "Mark") (4 . "Michael") (5 . "Randy"))
Keys = (1 2 3)
Filtered data = ("Chuck" "John" "Mark")
Data = ((1 . "Chuck") (2 . "John") (3 . "Mark") (4 . "Michael") (5 . "Randy"))
Keys = (1 3 5)
Filtered data = ("Chuck" "Mark" "Randy")
-
Well I'm too slow as usual, but here is my expiation attempt.
(defun ForFun ( / data result )
;; (while ..) - Returns The most recent value of the last expr. therefore in this case
;; it will return the 'result'
;; (tblnext table-name [rewind]) - get the next related item in the table
;; [rewind] If present and not nil, the first entry in it is retrieved
;; in this case (null data) returns T the first time through thus causing
;; the first record to be returned, thereafter it is nil & steps through the table
(while (setq data (tblnext "layer" (null data)))
(setq result ; collect the result each time through the loop
(cons ; (cons new-first-element list-or-atom) make a list
; because 'result' is nil the first time through and nil is considered
; a list, 'setq result' gets the first list from the mapcar and makes
; it a list, ((<mapcar output>)) on subsequent loops it becomes
; ((<mapcar output3>)(<mapcar output2>)(<mapcar output1>))
(mapcar ; Returns a list of the result of executing a function with the individual elements of a list
; In this case each item from the list (2 62 6) is fed to the lambda one at a time
; first 2, then 62 and finally 6
'(lambda (key) ; Defines an anonymous function
(cdr (assoc key data)) ; This function you know, assoc returns the list or pair if a match is found
; if 'data' is ((0 . "LAYER") (2 . "0") (70 . 0) (62 . 7) (6 . "Continuous"))
; (assoc 2 data ) returns (2 . "0") which is layer "0"
; (cdr (2 . "0")) returns "0"
)
'(2 62 6) ; this is the list in the mapcar statement
)
result ; this the list in the cons statement
)
)
)
)
<spelling>
-
whoa! I learned more from the last three posts than I have in the last year... now I need a nap. :lol:
Realizing that the data var was not valid returning a T, was like "Well of course why didn't I know that". :ugly: And it took me a minute to get around the (mapcar (lambda to pull the layer, color and linetype (2 62 6), but I think I got it.
KEWL, Thanks guys.
-
Mapcar-lambda is easy. Here, watch:
Mapcar: Do <something> to every item in a list.
Lambda: Same as defun but no `name' ...A Lambda is list of process' just like a formal(named) procedure.
Demonstrations:
Mapcar can be remade like this (For the sake of this convo just conern your self with the basics.):
Demonstration will demonstrate the process of printing each item in a list.
(defun print-it (lst)
(if (null lst)
;; if the list is `empty' or `nil'
nil
;; return `nil'
(progn
;; otherwise
(princ (car lst))
;; print the first item in the list
(print-it (cdr lst))
;; strip off the first item(cause we just printed it) and go thur again.
)
)
)
lambda is even easier to unerstand. Since it is nothing more then a formal procedure without a name it can be defined on the fly(so to speak) or at the point of use/need.
( (lambda () (1+ 2)) )
Will return what? ...3. Good.
So, a Mapcar-Lambda statment is saying nothing more then: "Preform <this> function on each and every item in a list."
How's that? Is the process a bit more clear?
-
Got it, thanks. I now have a whole new realm of applications buzzing in me punkin' head.
-
Got it, thanks. I now have a whole new realm of applications buzzing in me punkin' head.
BTDT -- I can recommend a good sleep clinic.
-
Got it, thanks. I now have a whole new realm of applications buzzing in me punkin' head.
BTDT -- I can recommend a good sleep clinic.
nah, at my age excitement is self-limiting, 10 minutes of thinkin', and I gotta take a nap.
I said "THINKIN'", now.
-
<mutter> preemptive <expletive> <grumble>
-
(setq lst nil)
(while (setq item (tblnext "LAYER" (not item)))
(setq lst (cons (list (cdadr item) (cdar (cdddr item)) (cdadr (cdddr item))) lst)))
Rev = correction, forgot the first layer... one more time.... another change made... Hey.... I think I need the new lisp book by Mark soon!!!!!
-
(setq lst nil)
(tblnext "LAYER" t)
(while (setq item (tblnext "LAYER"))
(setq lst (cons (list (cdadr item) (cdar (cdddr item)) (cdadr (cdddr item))) lst)))
That's just evil Luis.
-
what :evil: :evil: :evil:
:lmao:
At least it wasn't
(setq lst nil)
(tblnext "LAYER" t)
(while (setq item (tblnext "LAYER"))
(setq
lst
(list
(cdr
(car
(cdr item)
)
)
(cdr
(car
(cdr
(cdr
(cdr item)
)
)
)
)
(cdr
(car
(cdr
(cdr
(cdr
(cdr item)
)
)
)
)
)
)
)
)
ps
if that is a bad code I apologize... have been a looooooooong time, that I do not wrote anything in autolisp.... :cry:
Not at all. Just thought it was funny, see above I did before you posted this one.
-
Oops. Forgot the "cons" part, but you get the idea. All in good fun.
-
I like seeing the (cadar... stuff, it just seems that people don't use it very often. That is why I was said that you were evil (joking of course) because people don't seem to grasp it that easily.
:angel:
-
Thats because recursion is alot easier to follow. I cant rember anything beiond `car' and `cdr'. Seriously! If I am forced to use anything beiond that, I use `nth'.
-
(setq lst nil)
(while (setq item (tblnext "LAYER" (not item)))
(setq lst (cons (list (cdadr item) (cdar (cdddr item)) (cdadr (cdddr item))) lst)))
Rev = correction, forgot the first layer... one more time.... another change made... Hey.... I think I need the new lisp book by Mark soon!!!!!
... and when Adesk decides to include truecolor codes in the TBLxxx return values? No big deal, I know, but I prefer ASSOC over fixed positions
:angel:
-
ouch, my head hurts...
....what does an aneurysm feel like?? (http://www.theswamp.org/screens/cadaver/smilie/blowup.gif) :doa:
-
... and when Adesk decides to include truecolor codes in the TBLxxx return values? No big deal, I know, but I prefer ASSOC over fixed positions
yep it is just another way.... do you think they will do any improvement or addition to autolisp/visuallisp?.... according to Peter Funk from adesk lisp is just in maintenance mode... no plans to add any mayor additions.
:-)
-
do you think they will do any improvement or addition to autolisp/visuallisp?
No way they'll improve or add to it. Just being an old conservative fart here :wink:
-
not elegant....
but work...
(defun fortry (/ list1)
(foreach n (ai_table "layer" 0)
(setq list1
(append list1 (list (list n
(cdr (assoc 70 (entget (tblobjname "layer" n))))
(cdr (assoc 290 (entget (tblobjname "layer" n))))
(cdr (assoc 6 (entget (tblobjname "layer" n))))
(cdr (assoc 62 (entget (tblobjname "layer" n))))
))))))