Hey guys,
Although I've seen this sub of Lee Mac through the years -
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(LM:acdoc)
)
I was recently inspired by MP's sub from
this thread -
(list '
defun 'mp
-get
-owner '
( object
/ owner
) )
)
)
)
)
'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?
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:
;; 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
) )
( (_dottedpair-p f)
f
)
); cond
); list
)
)
(
'((xx)
( (_dottedpair-p xx)
)
)
)
(diseval x)
)
)
)
); (listp x)
); cond
); defun
); defun _DisEval
Sample usage:
(_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))
)
(_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>")
)
)
)
)
You can also perform nested DisEval-uations on any code and then nestedly
evaluate it:
_$ (eval (eval (eval (eval (eval (_DisEval (_DisEval (_DisEval (_DisEval '(ssget "_:L-I" '((0 . "CIRCLE")(8 . "0"))))))))))))
<Selection set: 2f>
_$ ( (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)
)
)
)
)
)
)
_$ ( (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>
You can also DisEval-uate and
evaluate bunch of subs/code like so:
(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
)
)
)
)
or like in this example that guarantees that it works properly -
(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
)
)
)
)
So in the end..
_$ (_DisEval ;; Inspect 'n Pretty-print
'
(defun mp
-get
-owner
( object
/ owner
) )
)
)
)
)
owner
)
)
>>
'MP-GET-OWNER
nil
'OWNER
)
)
)
)
)
'OWNER
)
Cheers!
(going back to my busy life, so sorry if I don't reply on time)