TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: MP on June 01, 2006, 11:21:02 PM
-
I needed a quick function today to print a list's hierarchy (data in native format; i.e. prin1) so I could discern a deeply nested structure. I wrote it quick and dirty and it surely could be optimized (example don't calculate (chr 40|41) each call, use foreach instead of mapcar ... ). You're welcome | invited to do so if you're inclined but it's been a long day for me so I'm opting out.
Without further blather --
(defun Prinh ( x / _PrintItem _PrintList _Main )
(defun _PrintItem ( _PrintMethod item indents )
(princ "\n")
(repeat indents (princ " "))
(_PrintMethod item)
(princ)
)
(defun _PrintList ( _PrintMethod lst indents )
(_PrintItem _PrintMethod (chr 40) indents)
(mapcar '(lambda (x) (_Main x (1+ indents))) lst)
(_PrintItem _PrintMethod (chr 41) indents)
)
(defun _Main ( x indents )
(if (vl-consp x)
(if ((lambda (x) (and x (atom x))) (cdr x))
(_PrintItem prin1 x indents)
(_PrintList princ x indents)
)
(_PrintItem prin1 x indents)
)
)
(_Main x 0)
)
Examples --
;; print a non list item
(prinh pi)
3.14159
;; print a simple flat list --
(prinh '(0 1 2))
(
0
1
2
)
;; print a nested list --
(prinh '(0 (1 (2 (3 (4 (5 (6 (7)))))))))
(
0
(
1
(
2
(
3
(
4
(
5
(
6
(
7
)
)
)
)
)
)
)
)
fwiw; cheers.
-
Interesting, MP. I'm trying to picture when I'll need something like this. Thanks.
-
One example could be entity data, in particular when xdata, xdictionaries or xrecords are involved.
Here's a simple example using a viewport with frozen layers (cut down a bit in the interests of brevity) --
(defun c:ListH ( / ename )
(if (setq ename (car (entsel)))
(prinh (entget ename '("*")))
)
)
(
(-1 . <Entity name: 7ef84f98>)
(0 . "VIEWPORT")
(330 . <Entity name: 7ef84d40>)
(5 . "AB")
(100 . "AcDbEntity")
(67 . 1)
(410 . "Layout1")
(8 . "0")
(100 . "AcDbViewport")
(
10
2.72966
2.78451
0.0
)
(40 . 2.35338)
...
(72 . 1000)
(331 . <Entity name: 7ef84c80>)
(331 . <Entity name: 7ef88090>)
(331 . <Entity name: 7ef88098>)
...
(170 . 0)
(
-3
(
"ACAD"
(1000 . "MVIEW")
(1002 . "{")
(1070 . 16)
(
1010
0.0
0.0
0.0
)
...
(1070 . 0)
(1002 . "{")
(1003 . "Lions")
(1003 . "Tigers")
(1003 . "And")
(1003 . "Bears")
(1003 . "Oh")
(1003 . "My!")
(1002 . "}")
(1002 . "}")
)
)
)
-
Interesting code MP. Makes me think about a having a routine to pretty print a lisp file.
-
Interesting code MP. Makes me think about a having a routine to pretty print a lisp file.
(defun-q Prinh ( x / _PrintItem _PrintList _Main )
(defun _PrintItem ( _PrintMethod item indents )
(princ "\n")
(repeat indents (princ " "))
(_PrintMethod item)
(princ)
)
(defun _PrintList ( _PrintMethod lst indents )
(_PrintItem _PrintMethod (chr 40) indents)
(mapcar '(lambda (x) (_Main x (1+ indents))) lst)
(_PrintItem _PrintMethod (chr 41) indents)
)
(defun _Main ( x indents )
(if (vl-consp x)
(if ((lambda (x) (and x (atom x))) (cdr x))
(_PrintItem prin1 x indents)
(_PrintList princ x indents)
)
(_PrintItem prin1 x indents)
)
)
(_Main x 0)
)
(prinh prinh)
(
(
X
/
_PRINTITEM
_PRINTLIST
_MAIN
)
(
DEFUN
_PRINTITEM
(
_PRINTMETHOD
ITEM
INDENTS
)
(
PRINC
"\n"
)
(
REPEAT
INDENTS
(
PRINC
" "
)
)
(
_PRINTMETHOD
ITEM
)
(
PRINC
)
)
(
DEFUN
_PRINTLIST
(
_PRINTMETHOD
LST
INDENTS
)
(
_PRINTITEM
_PRINTMETHOD
(
CHR
40
)
INDENTS
)
(
MAPCAR
(
QUOTE
(
LAMBDA
(
X
)
(
_MAIN
X
(
1+
INDENTS
)
)
)
)
LST
)
(
_PRINTITEM
_PRINTMETHOD
(
CHR
41
)
INDENTS
)
)
(
DEFUN
_MAIN
(
X
INDENTS
)
(
IF
(
VL-CONSP
X
)
(
IF
(
(
LAMBDA
(
X
)
(
AND
X
(
ATOM
X
)
)
)
(
CDR
X
)
)
(
_PRINTITEM
PRIN1
X
INDENTS
)
(
_PRINTLIST
PRINC
X
INDENTS
)
)
(
_PRINTITEM
PRIN1
X
INDENTS
)
)
)
(
_MAIN
X
0
)
)
Funny, almost looks like my vertical coding style; bwaaa!
:-D
-
Funny, almost looks like my vertical coding style; bwaaa!
Niceness. It does resemble your formatting style a little. Just noticed too, the subtle change of switching to Defun-q so that the actual code can be manipulated.
-
Just noticed too, the subtle change of switching to Defun-q so that the actual code can be manipulated.
Wasn't that I wanted to be able to manipulate prinh, I just wanted to demonstrate you could walk a function's code if were defuned by defun-q. Rather than pen a contrived sample function using defun-q for prinh to examine, I thought it would be fun to have prinh look up its own skirt.
:)
-
Command: (defun prinh_2 (x)
(_> (if (atom x)
((_> x
((_> (cons (prinh_2 (car x))
(((_> (prinh_2 (cdr x)))) )
PRINH_2
Command: (prinh_2 pi)
3.14159
Command: (prinh_2 '(1 2 3 (4 5 (6 7)) 8 9 (0)))
(1 2 3 (4 5 (6 7)) 8 9 (0))
Command: (prinh_2 3.14)
3.14
-
Command: (defun prinh_2 (x)
(_> (if (atom x)
((_> x
((_> (cons (prinh_2 (car x))
(((_> (prinh_2 (cdr x)))) )
PRINH_2
Command: (prinh_2 pi)
3.14159
Command: (prinh_2 '(1 2 3 (4 5 (6 7)) 8 9 (0)))
(1 2 3 (4 5 (6 7)) 8 9 (0))
Command: (prinh_2 3.14)
3.14
??
-
fwiw, this is what I ended up putting in my library. It's not the most concise but it seems to run reliably, reasonably quickly AND I can understand it.
(defun Prinh ( x / _PrintItem _PrintList _Main )
(defun _PrintItem ( _PrintMethod item indents )
(princ "\n")
(repeat indents (princ " "))
(_PrintMethod item)
(princ)
)
(defun _PrintList ( _PrintMethod lst indents )
(_PrintItem _PrintMethod "(" indents)
((lambda (i) (foreach x lst (_Main x i))) (1+ indents))
(_PrintItem _PrintMethod ")" indents)
)
(defun _Main ( x indents )
(if (vl-consp x)
(if ((lambda (x) (and x (atom x))) (cdr x))
(_PrintItem prin1 x indents)
(_PrintList princ x indents)
)
(_PrintItem prin1 x indents)
)
)
(_Main x 0)
)
-
Michael
This maybe a stupid question on my part, but I will ask anyway. Could this routine be used on a dcl code?
Gary
-
Hi Gary.
It's not a stupid question, I could see how a function that hiearchically displays dcl code might be useful for development / debugging purposes. However, as currently coded, prinh could not be used on dcl code directly.
- Michael.
-
Hey Gary --
IF you preprocessed a dcl definition a slight mod to prinh might work for you.
Example, a standard AutoCAD dcl definition (from tblname.dcl) --
tblname : dialog
{
label = "";
key="dlgTitle";
: column
{
: spacer {}
: text_part
{
key="msg";
label="";
}
: boxed_column {
fixed_width=true;
width=50;
: list_box {
key="name_list";
}
: row {
: button {
fixed_width=true;
width=5;
key="pickit";
label= "&Pick<";
alignment=left;
}
: edit_box {
key="name";
is_default=true;
edit_limit=256;
alignment=left;
fixed_width=true;
width=41;
}
} //row
: spacer {}
} // boxed column
: row
{
: spacer {}
: button {
fixed_width=true;
width=11;
key="accept";
label= "OK";
}
: button {
fixed_width=true;
width=11;
is_cancel=true;
key="cancel";
label= "Cancel";
}
: button {
fixed_width=true;
width=11;
key="help";
label= "&Help";
is_help=true;
}
: spacer {}
} // row
: text_part
{
key="error";
label="";
}
} // column
}
Step 1:
• trim leading/trailing space
• force statements / braces to their own line
• delete comments
• replace quotes (") with backslash quote (\")
tblname : dialog
{
label = \"\";
key=\"dlgTitle\";
: column
{
: spacer
{
}
: text_part
{
key=\"msg\";
label=\"\";
}
: boxed_column
{
fixed_width=true;
width=50;
: list_box
{
key=\"name_list\";
}
: row
{
: button
{
fixed_width=true;
width=5;
key=\"pickit\";
label= \"&Pick<\";
alignment=left;
}
: edit_box
{
key=\"name\";
is_default=true;
edit_limit=256;
alignment=left;
fixed_width=true;
width=41;
}
}
: spacer
{
}
}
: row
{
: spacer
{
}
: button
{
fixed_width=true;
width=11;
key=\"accept\";
label= \"OK\";
}
: button
{
fixed_width=true;
width=11;
is_cancel=true;
key=\"cancel\";
label= \"Cancel\";
}
: button
{
fixed_width=true;
width=11;
key=\"help\";
label= \"&Help\";
is_help=true;
}
: spacer
{
}
}
: text_part
{
key=\"error\";
label=\"\";
}
}
}
Step 2:
• enclose all lines in quotes except brace lines
• convert braces { } to parenthesis ( )
"tblname : dialog"
(
"label = \"\";"
"key=\"dlgTitle\";"
": column"
(
": spacer"
(
)
": text_part"
(
"key=\"msg\";"
"label=\"\";"
)
": boxed_column"
(
"fixed_width=true;"
"width=50;"
": list_box"
(
"key=\"name_list\";"
)
": row"
(
": button"
(
"fixed_width=true;"
"width=5;"
"key=\"pickit\";"
"label= \"&Pick<\";"
"alignment=left;"
)
": edit_box"
(
"key=\"name\";"
"is_default=true;"
"edit_limit=256;"
"alignment=left;"
"fixed_width=true;"
"width=41;"
)
)
": spacer"
(
)
)
": row"
(
": spacer"
(
)
": button"
(
"fixed_width=true;"
"width=11;"
"key=\"accept\";"
"label= \"OK\";"
)
": button"
(
"fixed_width=true;"
"width=11;"
"is_cancel=true;"
"key=\"cancel\";"
"label= \"Cancel\";"
)
": button"
(
"fixed_width=true;"
"width=11;"
"key=\"help\";"
"label= \"&Help\";"
"is_help=true;"
)
": spacer"
(
)
)
": text_part"
(
"key=\"error\";"
"label=\"\";"
)
)
)
Step 3
• enclose the whole mess in quoted list '( ... )
• assign to a variable
(setq dcldef
'(
"tblname : dialog"
(
"label = \"\";"
"key=\"dlgTitle\";"
": column"
(
": spacer"
(
)
": text_part"
(
"key=\"msg\";"
"label=\"\";"
)
": boxed_column"
(
"fixed_width=true;"
"width=50;"
": list_box"
(
"key=\"name_list\";"
)
": row"
(
": button"
(
"fixed_width=true;"
"width=5;"
"key=\"pickit\";"
"label= \"&Pick<\";"
"alignment=left;"
)
": edit_box"
(
"key=\"name\";"
"is_default=true;"
"edit_limit=256;"
"alignment=left;"
"fixed_width=true;"
"width=41;"
)
)
": spacer"
(
)
)
": row"
(
": spacer"
(
)
": button"
(
"fixed_width=true;"
"width=11;"
"key=\"accept\";"
"label= \"OK\";"
)
": button"
(
"fixed_width=true;"
"width=11;"
"is_cancel=true;"
"key=\"cancel\";"
"label= \"Cancel\";"
)
": button"
(
"fixed_width=true;"
"width=11;"
"key=\"help\";"
"label= \"&Help\";"
"is_help=true;"
)
": spacer"
(
)
)
": text_part"
(
"key=\"error\";"
"label=\"\";"
)
)
)
)
)
Step 4
• message the prinh function to suit (a very fast stab)
(defun _PrinDcl ( x / _PrintItem _PrintList _Main )
(defun _PrintItem ( _PrintMethod item indents )
(cond
( item
(princ "\n")
(repeat indents (princ " "))
(_PrintMethod item)
)
( (princ " { }") )
)
(princ)
)
(defun _PrintList ( _PrintMethod lst indents )
(if (< -1 indents) (_PrintItem _PrintMethod "{" indents))
((lambda (i) (foreach x lst (_Main x i))) (1+ indents))
(if (< -1 indents) (_PrintItem _PrintMethod "}" indents) (princ))
)
(defun _Main ( x indents )
(if (vl-consp x)
(if ((lambda (x) (and x (atom x))) (cdr x))
(_PrintItem princ x indents) ;; formerly prin1
(_PrintList princ x indents)
)
(_PrintItem princ x indents) ;; formerly prin1
)
)
(_Main x -1)
)
Step 5
• Run it
(PrinDCL dcldef)
Result
tblname : dialog
{
label = "";
key="dlgTitle";
: column
{
: spacer ()
: text_part
{
key="msg";
label="";
}
: boxed_column
{
fixed_width=true;
width=50;
: list_box
{
key="name_list";
}
: row
{
: button
{
fixed_width=true;
width=5;
key="pickit";
label= "&Pick<";
alignment=left;
}
: edit_box
{
key="name";
is_default=true;
edit_limit=256;
alignment=left;
fixed_width=true;
width=41;
}
}
: spacer { }
}
: row
{
: spacer { }
: button
{
fixed_width=true;
width=11;
key="accept";
label= "OK";
}
: button
{
fixed_width=true;
width=11;
is_cancel=true;
key="cancel";
label= "Cancel";
}
: button
{
fixed_width=true;
width=11;
key="help";
label= "&Help";
is_help=true;
}
: spacer { }
}
: text_part
{
key="error";
label="";
}
}
}
All you have to do is code up functions to achieve steps 1 - 3.
:)
-
Michael
Thanks...I was hoping this could be done.
Gary
-
Hi Gary.
It's not a stupid question, I could see how a function that hiearchically displays dcl code might be useful for development / debugging purposes. However, as currently coded, prinh could not be used on dcl code directly.
- Michael.
Dear MP,
Could you please change the code to automatively creat dcl file? tks!
-
I think the point was for [you] to create it.
[ http://www.theswamp.org/index.php?topic=10398.msg132473#msg132473 ]
(read the last sentence in that post)
-
creat dcl file
(defun creatdcl (x / _printitem _printlist _main acadfn fn)
(setq acadfn (findfile "ACAD.PAT")
fn (strcat (substr acadfn 1 (- (strlen acadfn) 8)) "temp.dcl")
fn (open fn "w")
)
(defun _printitem (item)
(cond
(item (princ (strcat " " item) fn) (write-line "" fn))
(t
(princ " { }" fn)
(write-line "" fn)
)
)
(princ)
)
(defun _printlist (lst indents)
(if (< -1 indents)
(_printitem "{")
)
((lambda (i)
(foreach x lst
(_main x i)
)
)
(1+ indents)
)
(if (< -1 indents)
(_printitem "}")
(princ)
)
)
(defun _main (x indents)
(if (vl-consp x)
(if ((lambda (x)
(and
x
(atom x)
)
)
(cdr x)
)
(_printitem x)
(_printlist x indents)
)
(_printitem x)
)
)
(_main x -1)
(close fn)
(princ)
)
-
All you have to do is code up functions to achieve steps 1 - 3.
I actually found this quite a bit more difficult than I had first anticipated...
Anyway, here is what I came up with:
(defun c:FormatDCL ( / _Read _PrinDCL _Main )
(defun _Read ( file / _break line cpos alst )
(defun _break ( line chrs / _breakit )
(defun _breakit ( strn delm / cpos )
(if (setq cpos (vl-string-search delm strn))
(vl-remove ""
(cons (substr strn 1 cpos)
(cons delm (_breakit (substr strn (+ 2 cpos)) delm))
)
)
(list strn)
)
)
(if (cdr chrs)
(apply 'append
(mapcar '(lambda ( x ) (_break x (cdr chrs))) (_breakit line (car chrs)))
)
(_breakit line (car chrs))
)
)
(if (setq file (open file "r"))
(progn
(while (setq line (read-line file))
(cond
( (setq cpos (vl-string-search "//" line))
(setq line (substr line 1 cpos))
)
( (setq cpos (vl-string-search "/*" line))
(setq _str (substr line 1 cpos))
(while
(and line
(not (setq cpos (vl-string-search "*/" line)))
)
(setq line (read-line file))
)
(if line
(setq str_ (substr line (+ 3 cpos)))
(setq str_ "")
)
(setq line (strcat _str str_))
)
)
(setq alst
(append alst
(vl-remove-if 'null
(mapcar
(function
(lambda ( x )
(setq x (vl-string-trim " " x))
(cond
( (member x '("{" "}"))
x
)
( (< 0 (strlen x))
(vl-prin1-to-string (vl-string-trim " " x))
)
)
)
)
(_break line '("{" "}"))
)
)
)
)
)
(setq file (close file))
)
)
alst
)
;; _PrinDcl by MP
;; http://www.theswamp.org/index.php?topic=10398.msg132473#msg132473
(defun _PrinDcl ( x / _PrintItem _PrintList _Main )
(defun _PrintItem ( _PrintMethod item indents )
(cond
( item
(princ "\n")
(repeat indents (princ " "))
(_PrintMethod item)
)
( (princ " { }") )
)
(princ)
)
(defun _PrintList ( _PrintMethod lst indents )
(if (< -1 indents) (_PrintItem _PrintMethod "{" indents))
((lambda ( i ) (foreach x lst (_Main x i))) (1+ indents))
(if (< -1 indents) (_PrintItem _PrintMethod "}" indents) (princ))
)
(defun _Main ( x indents )
(if (vl-consp x)
(if ((lambda ( x ) (and x (atom x))) (cdr x))
(_PrintItem princ x indents)
(_PrintList princ x indents)
)
(_PrintItem princ x indents)
)
)
(_Main x -1)
)
(defun _Main ( / file )
(if (setq file (getfiled "Select DCL File" "" "dcl" 16))
(_PrinDCL
(read
(strcat "(" (vl-string-translate "{}" "()" (apply 'strcat (_Read file))) ")")
)
)
(princ "\n*Cancel*")
)
(princ)
)
(_Main)
)
Function will read a selected DCL file and print a formatted version to the command-line.
@MP: Fantastic work with the Prin* functions, I really like the cross-recursive call. :-)
-
Bwaaaaaa, lmao ... 5 years later proves useful. :lmao:
Nice work + thanks for the nod Lee. :)
-
Bwaaaaaa, lmao ... 5 years later proves useful. :lmao:
Better late than never :lol:
Nice work + thanks for the nod Lee. :)
Thanks dude :-)