Code Red > AutoLISP (Vanilla / Visual)
DisEval
Grrr1337:
Hey guys,
Although I've seen this sub of Lee Mac through the years -
--- Code - Auto/Visual Lisp: ---;; Active Document - Lee Mac;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc))
I was recently inspired by MP's sub from this thread -
--- Code - Auto/Visual Lisp: ---(eval (list 'defun 'mp-get-owner '( object / owner ) (list 'vl-catch-all-apply (list 'function (list 'lambda nil (list 'setq 'owner (list 'vla-objectidtoobject (vla-get-activedocument (vlax-get-acad-object)) (list 'vla-get-ownerid 'object) ) ) ) ) ) 'owner ))
Got me thinking, did he first wrote the sub and then refactored it manually to be used with eval, or maybe he have already automated the refactoring part? :thinking:
Despite my accumulation of LISP writing experience I would struggle to refactor any code in order to disevaluate it.
So I played the last few days and I'm sharing with you my DisEval sub:
--- Code - Auto/Visual Lisp: ---;; DisEval - (Inverse evaluator);; Grrr [21.10.2020](defun _DisEval ( f / _dottedpair-p diseval ) ; _$ (_dottedpair-p '(-4 . "OR>")) >> T ; _$ (_dottedpair-p '(1 2 3)) >> nil ; _$ (_dottedpair-p "ABC") >> nil ; _$ (_dottedpair-p nil) >> nil (defun _dottedpair-p ( x ) (and (vl-consp x) (vl-catch-all-error-p (vl-catch-all-apply (function length) (list x)))) ) (defun diseval ( f / x ) (setq x (if (listp f) (car f) f)) (cond ( (not f) f) ( (_dottedpair-p f) f ) ( (atom x) (append (list (cond ((null x) x) ((numberp x) x) ((eq t x) x) ( (read (strcat "'" (vl-prin1-to-string x))) ) ); cond ); list (diseval (if (listp f) (cdr f))) ) ) ( (listp x) (append (list ( '((xx) (cond ( (_dottedpair-p xx) (list 'cons (car xx) (cdr xx)) ) ( (cons 'list xx) ) ) ) (diseval x) ) ) (diseval (if (listp f) (cdr f))) ) ); (listp x) ); cond ); defun (if (vl-consp f) (cons 'list (diseval f)))); defun _DisEval
Sample usage:
--- Code: ---(_DisEval
'(defun AcDoc nil
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
>> (LIST (QUOTE DEFUN) (QUOTE ACDOC) nil (LIST (QUOTE vla-get-ActiveDocument) (LIST (QUOTE vlax-get-acad-object))))
>> Pretty-printed:
(LIST 'DEFUN 'ACDOC nil
(LIST 'vla-get-ActiveDocument (LIST 'vlax-get-acad-object))
)
--- End code ---
--- Code: ---(_DisEval
'(LM:ssget "\nSelect lines, arcs and/or polylines to extend: "
'("_:L"
(
(-4 . "<OR")
(0 . "LINE,ARC")
(-4 . "<AND")
(0 . "LWPOLYLINE")
(-4 . "<NOT")
(-4 . "&=") (70 . 1)
(-4 . "NOT>")
(-4 . "AND>")
(-4 . "<AND")
(0 . "POLYLINE")
(-4 . "<NOT")
(-4 . "&=") (70 . 87)
(-4 . "NOT>")
(-4 . "AND>")
(-4 . "OR>")
)
)
)
)
>>
(LIST 'LM:SSGET
'"\nSelect lines, arcs and/or polylines to extend: "
(LIST 'QUOTE
(LIST '"_:L"
(LIST
(CONS -4 "<OR")
(CONS 0 "LINE,ARC")
(CONS -4 "<AND")
(CONS 0 "LWPOLYLINE")
(CONS -4 "<NOT")
(CONS -4 "&=")
(CONS 70 1)
(CONS -4 "NOT>")
(CONS -4 "AND>")
(CONS -4 "<AND")
(CONS 0 "POLYLINE")
(CONS -4 "<NOT")
(CONS -4 "&=")
(CONS 70 87)
(CONS -4 "NOT>")
(CONS -4 "AND>")
(CONS -4 "OR>")
)
)
)
)
--- End code ---
You can also perform nested DisEval-uations on any code and then nestedly evaluate it:
--- Code: ---_$ (eval (eval (eval (eval (eval (_DisEval (_DisEval (_DisEval (_DisEval '(ssget "_:L-I" '((0 . "CIRCLE")(8 . "0"))))))))))))
<Selection set: 2f>
--- End code ---
--- Code: ---_$ ( (lambda (n c / r ) (setq r c) (repeat n (setq r (_DisEval r))) r) 5
'(defun AcDoc nil
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(LIST
'LIST
(LIST 'QUOTE 'LIST)
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'LIST))
(LIST 'LIST
(LIST 'QUOTE 'LIST)
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'QUOTE))
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'LIST))
)
(LIST 'LIST
(LIST 'QUOTE 'LIST)
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'LIST))
(LIST 'LIST
(LIST 'QUOTE 'LIST)
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'QUOTE))
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'QUOTE))
)
(LIST 'LIST
(LIST 'QUOTE 'LIST)
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'QUOTE))
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'DEFUN))
)
)
(LIST 'LIST
(LIST 'QUOTE 'LIST)
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'LIST))
(LIST 'LIST
(LIST 'QUOTE 'LIST)
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'QUOTE))
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'QUOTE))
)
(LIST 'LIST
(LIST 'QUOTE 'LIST)
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'QUOTE))
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'ACDOC))
)
)
nil
(LIST
'LIST
(LIST 'QUOTE 'LIST)
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'LIST))
(LIST 'LIST
(LIST 'QUOTE 'LIST)
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'QUOTE))
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'LIST))
)
(LIST 'LIST
(LIST 'QUOTE 'LIST)
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'LIST))
(LIST 'LIST
(LIST 'QUOTE 'LIST)
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'QUOTE))
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'QUOTE))
)
(LIST 'LIST
(LIST 'QUOTE 'LIST)
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'QUOTE))
(LIST 'LIST
(LIST 'QUOTE 'QUOTE)
(LIST 'QUOTE 'vla-get-ActiveDocument)
)
)
)
(LIST
'LIST
(LIST 'QUOTE 'LIST)
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'LIST))
(LIST 'LIST
(LIST 'QUOTE 'LIST)
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'QUOTE))
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'LIST))
)
(LIST 'LIST
(LIST 'QUOTE 'LIST)
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'LIST))
(LIST 'LIST
(LIST 'QUOTE 'LIST)
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'QUOTE))
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'QUOTE))
)
(LIST 'LIST
(LIST 'QUOTE 'LIST)
(LIST 'LIST (LIST 'QUOTE 'QUOTE) (LIST 'QUOTE 'QUOTE))
(LIST 'LIST
(LIST 'QUOTE 'QUOTE)
(LIST 'QUOTE 'vlax-get-acad-object)
)
)
)
)
)
)
--- End code ---
--- Code: ---_$ ( (lambda (n c / r ) (setq r c) (repeat n (setq r (eval r))) r) 7 ; try from 5 up to 7
( (lambda (n c / r ) (setq r c) (repeat n (setq r (_DisEval r))) r) 5
'(defun AcDoc nil
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
);; (lambda)
#<USUBR @0000001c064381b0 ACDOC>
--- End code ---
You can also DisEval-uate and evaluate bunch of subs/code like so:
--- Code: ---(mapcar 'eval
(eval
(eval
(_DisEval
'(list
;; Bunch of codes...
(defun AcObj nil
(vlax-get-acad-object)
)
(defun AcDoc nil
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(defun AlertHello nil
(alert "Hello")
)
(defun SayHi nil
(princ "Hi")
)
;; ... bunch of codes
); list
)
)
)
)
--- End code ---
or like in this example that guarantees that it works properly -
--- Code: ---(mapcar 'eval
(eval
(eval
(_DisEval
'(list
;; i.e. paste the whole lisp content from here:
;; http://www.lee-mac.com/lisp/html/2DProjectionV1-0.html
); list
)
)
)
)
--- End code ---
So in the end..
--- Code - Auto/Visual Lisp: ---_$ (_DisEval ;; Inspect 'n Pretty-print '(defun mp-get-owner ( object / owner ) (vl-catch-all-apply (function (lambda nil (setq owner (vla-objectidtoobject (vla-get-activedocument (vlax-get-acad-object)) (vla-get-ownerid object) ) ) ) ) ) owner ))>>(LIST 'DEFUN 'MP-GET-OWNER (LIST 'OBJECT '/ 'OWNER) (LIST 'VL-CATCH-ALL-APPLY (LIST 'FUNCTION (LIST 'LAMBDA nil (LIST 'SETQ 'OWNER (LIST 'vla-ObjectIDToObject (LIST 'vla-get-ActiveDocument (LIST 'vlax-get-acad-object)) (LIST 'vla-get-OwnerID 'OBJECT) ) ) ) ) ) 'OWNER)
Cheers!
(going back to my busy life, so sorry if I don't reply on time)
JohnK:
Pardon my ignorance but what is wrong with:
--- Code - Auto/Visual Lisp: ---(setq *acadobject* (cond (*acadobject*) ((vlax-get-acad-object))) )
and on the lazy evaluation subject (I am unsure what "disevaluation" means) I've used a function I wrote a long time ago called "hook".
--- Code - Auto/Visual Lisp: ---(defun hook (func) ;; hook ;; this function will take an argument and turn it into a ;; lambda expression to evaluate. (You can assign to a variable ;; and exec it at a later time if you wish.) ;; ;; By: John (Se7en) K ;; (inspired by something I saw in one of ;; Vladimir Nesterovsky's procedures.) ;; ;; Ex: (hook '(+ 1 2)) ;; > ((LAMBDA nil (+ 1 2))) ;; (list (cons 'lambda (cons nil (list func)))) )
--- Code: ---> Command: (setq a (hook '(+ 1 2)))
> ((LAMBDA nil (+ 1 2)))
>
> Command: (eval a)
> 3
>
> Command: (setq a (hook '(+ 1 2))
> (_> b (hook '(+ 1 3))
> (_> c (hook '(+ 1 4))
> (_> d (hook '(+ 1 5))
> (_> e (hook '(+ 1 6))
> (_> f (hook '(+ 1 7)))
> ((LAMBDA nil (+ 1 7)))
>
> Command: (mapcar 'eval (mapcar 'eval '(a b c d e f)))
> (3 4 5 6 7 8)
--- End code ---
MP:
Yours uses a global variable set to acadapp, the alternative would encapsulate acadapp without a global.
JohnK:
Sorry, running late!!
There is nothing wrong with global variables (in this respect) is there?
What would be the difference between a variable and a function (aren't they both "symbols" in AutoLisp)?
If defun-q is a list can you modify that defun-q list like any other list (were there any problems with modifying those defun-q lists and evaluations)?
MP:
Personal preference that’s presumably ok with the lisp police.
Navigation
[0] Message Index
[#] Next page
Go to full version