;; There was once a question on CCA, about How to retrieve
;; the list of all frozen layers in some VIEWPORT.
;; Here're the functions for that, evolving with the time.
(defun get-frozen-layers (vp-ename)
(last (last (get-xdata vp-ename "ACAD"))))
;; get EED as an arbitrary list of values, w/out any specific codes (1040 etc).
;; 1002 '{' and '}' control codes actually processed as a
;; beginning / ending markers of lists and those sub-lists created,
;; thus converting the one-dimentional EED data stream into a tree-like
;; LISP list of arbitrary structure
(defun get-xdata (ename appname)
(re-list ;; reconstruct list
(mapcar 'cdr ;; of values
(cdadr (assoc -3 ;; of EED code-groups
(entget ename (list (strcase appname))))))))
;; Now we need to reconstruct list from it's
;; one-dimentional EED representation.
;; That's what RE-LIST is all about.
;; older version; a lot of stack space consumed
(defun re-list0 (l / rest) ;; lexical closure for REST of input stream
(re-list0-aux l)) ;; internal function
(defun re-list0-aux (l / tok) ;; RECURSIVE ITERATION ! :) :)
(setq tok (car l) rest (cdr l)) ;; get first element and advance
(cond
((null l) nil) ;; stop recursion!
((= "}" tok) nil) ;; stop recursion! REST contains the rest of stream.
((= "{" tok) (cons (re-list0-aux rest) (re-list0-aux rest)))
(T (cons tok (re-list0-aux rest)))))
;; {{I call it Recursive Iteration :) because it builds the list
;; structure by recursion, but scans the input list with iteration,
;; when recursive AUX function changes an OUTER variable REST,
;; and NOT the one it got as its argument.}}
;; the functions below can be used to watch how re-list0 is working
(setq *verbose* 'T) ;; set to NIL to suppress output
(defun re-list0p (l / inp) ;; with Print Out
(re-list0p-aux 2 l)
(princ) )
(defun re-list0p-aux (k l / tok);; RECURSIVE ITERATION ! :} :}
(prink "TOK: " (setq tok (car l)))
(setq inp (cdr l))
(prink "RES: "
(cond
((null l) nil) ;; stop recursion!
((= "}" tok) nil) ;; stop recursion! INPut continues.
((= "{" tok)
(cons
(re-list0p-aux (+ k 2) (prink "FIRST : " inp) )
(re-list0p-aux (+ k 2) (prink "SECOND: " inp))))
(T (cons
tok
(re-list0p-aux (+ k 2) (prink "REST : " inp)))))))
(DEFUN prink (m x)
(IF *verbose*
(PROGN
(PRINC "\n")
(REPEAT k (PRINC " "))
(PRINC m)
(PRIN1 x))
x))
;; end of print-out version
;; RE-LIST0 can be further optimized in order to minimize stack space
;; consumption. Actually, REST is a redundant variable. I can just
;; as well use L itself for keeping track of iteration, so AUX function
;; would take no arguments (working on outer variable L), thus saving
;; greatly on stack. TOK variable can be eliminated by using
;; two utility functions, DEL1 and POP, for advancing on list L.
;; delete first element from the list, discarding its value.
(defun del1 ( _q_lst ) ;; a quoted SYM of list as argument
(set _q_lst (cdr (eval _q_lst))))
;; delete first element from list, returning its value.
(defun pop ( _q_lst / _v )
(setq _v (car (eval _q_lst)))
(set _q_lst (cdr (eval _q_lst)))
_v )
;; next version; trying to save on stack space
(defun re-list1 (l) ;; working on this L
(re-list1-aux)) ;; internal function
;; here it is, with comments and explanations of how recursion works:
(defun re-list1-aux () ;; the working function for re-list()
(cond ;; WHEN
((null lst) ;; input list ends:
nil) ;; stop recursion.
((= "}" (car lst)) ;; "}" is encountered:
(del1 'lst) ;; advance on input list, discarding the "}" symbol
nil) ;; and stop recursion
((= "{" (car lst)) ;; "{" is encountered: make inner list:
(del1 'lst) ;; advance on input list, discarding the "{" symbol
(cons ;; and then add
(re-list1-aux);; a result of processing up to matching "}"
(re-list1-aux);; to the result of processing what's left.
))
(T (cons ;; regular case: add
(pop 'lst) ;; first element
(re-list1-aux) ;; to the result of processing what's left.
))))
;; It may be optimized even further. I tried to save stack
;; space and hence used DEL1 and POP, but I can use TOK as well
;; declaring it as a local var of main function, and not the
;; inner, recursive one.
;; To show a concept in more clear way, --
(defun re-list2 (l / tok)
(re-list2-aux))
(defun read-token()
(setq tok (car l) l (cdr l))
tok)
(defun re-list2-aux()
(if l ;; if input ended, return NIL immediately
(cond ;; else
((= (read-token) "}") nil)
((= tok "{") (cons (re-list2-aux) (re-list2-aux)))
(T (cons tok (re-list2-aux))))))
;; The COND clause may be regrouped into IFs, and read-token
;; inlined. Here's the simplest, shortest RE-LIST, using the
;; least possible stack space (I hope) :)
(DEFUN re-list (lst / tok aux ?)
(DEFUN aux ()
(IF (AND lst
(SETQ tok (CAR lst) lst (CDR lst) ? (/= tok "}")))
(CONS (IF (= tok "{") (aux) tok) (aux))))
(aux))
;; This defines AUX function and calles it immediately.
;; AUX works recursively on its OUTER variable, LST,
;; iterating over it. Return value is being built as a result
;; of recursion process, when each invocation of recursive
;; function iterates over input list. {Wow! \;} :)
;; The reason I am so excited about this little thing is because
;; it's a READER function, meaning that it is used to read
;; some sort of description language, ananlyze it and build
;; some structures from it. It means that similar approach
;; can be used to build another READER functions, for another
;; descriptive languages. In our case the language is very
;; simple, just (1002 . "{") and (1002 . "}") controls, but
;; it can be anything we need. PARSING an input file or
;; READING it is always a process of reading one-dimentional
;; input stream and converting it into some inner representation.
;; It is this principle that makes it possible to build various
;; interpretors and compilers.
;; So in fact RE-LIST is sort of a "compiler". :)
;; It "compiles" one-dimentional EED data stream into
;; a LISP tree-like lists.
;; It's also possible to use a LISP's built-in subr, READ, for
;; that, now that we've got the idea of "reading" -- although
;; to make one yourself is much more fun. :)
(defun re-list4 (lst)
(read (re-list4-aux lst)))
(defun re-list4-aux (lst) ;; original idea by Morten Warankov
(strcat
"("
(apply 'strcat
(mapcar
'(lambda(x)
(cond
((= x "{") "(")
((= x "}") ")")
((= 'REAL (type x))
(strcat (rtos x 2 20) " "))
((= 'INT (type x))
(strcat (rtos x 2 0) " "))
((= 'STR (type x))
(strcat "\"" x "\""))
((and x (listp x))
(re-list4-aux x))
(T "")
))
lst))
")"))
;; But then, it will fail if the list is not balanced,
;; whereas our RE-LIST will not. On the other hand,
;; re-list is still very stack-hangry, but re-list4
;; which uses built-in READ, is much more stable.
;; After some tests I found out that stack usage was
;; improved ONLY by 2%. :-( I guess that mainly it's used
;; for storing intermediate results of AUX functions,
;; and eliminating REST etc was very small improvement after all. :)
;; Still it was a nice exercise...
(princ)