[编程交流] 特定块/属性lisp

([color=BLUE]defun[/color] c:setattval ( [color=BLUE]/[/color] ent enx idx itm lst sel tag tmp val )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color] '((0 . [color=MAROON]"INSERT"[/color]) (66 . 1))))
       ([color=BLUE]progn[/color]
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] idx ([color=BLUE]sslength[/color] sel))
               ([color=BLUE]setq[/color] ent ([color=BLUE]entnext[/color] ([color=BLUE]ssname[/color] sel ([color=BLUE]setq[/color] idx ([color=BLUE]1-[/color] idx))))
                     enx ([color=BLUE]entget[/color] ent)
               )
               ([color=BLUE]while[/color] ([color=BLUE]=[/color] [color=MAROON]"ATTRIB"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 enx)))
                   ([color=BLUE]setq[/color] tag ([color=BLUE]strcase[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 enx)))
                         itm ([color=BLUE]assoc[/color] tag lst)
                   )
                   ([color=BLUE]if[/color] itm
                       ([color=BLUE]setq[/color] lst ([color=BLUE]subst[/color] ([color=BLUE]vl-list*[/color] tag enx ([color=BLUE]cdr[/color] itm)) itm lst))
                       ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color]  ([color=BLUE]list[/color] tag enx) lst))
                   )
                   ([color=BLUE]setq[/color] ent ([color=BLUE]entnext[/color] ent)
                         enx ([color=BLUE]entget[/color]  ent)
                   )
               )
           )
           ([color=BLUE]while[/color]
               ([color=BLUE]progn[/color] ([color=BLUE]setq[/color] tag ([color=BLUE]strcase[/color] ([color=BLUE]getstring[/color] [color=MAROON]"\nSpecify tag: "[/color])))
                   ([color=BLUE]cond[/color]
                       (   ([color=BLUE]=[/color] [color=MAROON]""[/color] tag) [color=BLUE]nil[/color])
                       (   ([color=BLUE]null[/color]  ([color=BLUE]setq[/color] tmp ([color=BLUE]vl-remove-if-not[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]wcmatch[/color] ([color=BLUE]car[/color] x) ([color=BLUE]strcat[/color] tag [color=MAROON]"*"[/color]))) lst)))
                           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nNo tags starting with ""[/color] tag [color=MAROON]"" found in selection."[/color]))
                       )
                       (   ([color=BLUE]cdr[/color] tmp)
                           ([color=BLUE]princ[/color]
                               ([color=BLUE]strcat[/color] [color=MAROON]"\n"[/color] ([color=BLUE]itoa[/color] ([color=BLUE]length[/color] tmp)) [color=MAROON]" matches found: "[/color]
                                   ([color=BLUE]substr[/color]  ([color=BLUE]apply[/color] '[color=BLUE]strcat[/color] ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]strcat[/color] [color=MAROON]","[/color] ([color=BLUE]car[/color] x))) tmp)) 2)
                                   [color=MAROON]" - Please be more specific."[/color]
                               )
                           )
                       )
                   )
               )
           )
           ([color=BLUE]if[/color] ([color=BLUE]/=[/color] [color=MAROON]""[/color] tag)
               ([color=BLUE]progn[/color]
                   ([color=BLUE]setq[/color] val ([color=BLUE]cons[/color] 1 ([color=BLUE]getstring[/color] [color=BLUE]t[/color] [color=MAROON]"\nSpecify new value: "[/color])))
                   ([color=BLUE]foreach[/color] enx ([color=BLUE]cdar[/color] tmp)
                       ([color=BLUE]if[/color] ([color=BLUE]entmod[/color] ([color=BLUE]subst[/color] val ([color=BLUE]assoc[/color] 1 enx) enx))
                           ([color=BLUE]entupd[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] -1 enx)))
                       )
                   )
                   ([color=BLUE]princ[/color]
                       ([color=BLUE]strcat[/color] [color=MAROON]"\n"[/color]
                           ([color=BLUE]itoa[/color] ([color=BLUE]length[/color] ([color=BLUE]cdar[/color] tmp)))
                           [color=MAROON]" attribute"[/color]
                           ([color=BLUE]if[/color] ([color=BLUE]cddar[/color] tmp) [color=MAROON]"s"[/color] [color=MAROON]""[/color])
                           [color=MAROON]" modified."[/color]
                       )
                   )
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)