以下是我的尝试:
- ([color=BLUE]defun[/color] c:fixblk ( [color=BLUE]/[/color] a b i s x )
- ([color=BLUE]if[/color] ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color] '((0 . [color=MAROON]"INSERT"[/color]) (66 . 1))))
- ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
- ([color=BLUE]mapcar[/color]
- '([color=BLUE]lambda[/color] ( a b )
- ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]vla-put-textstring[/color] ([color=BLUE]last[/color] a) ([color=BLUE]caddr[/color] b))) a b)
- )
- ([color=BLUE]setq[/color] a
- ([color=BLUE]vl-sort[/color]
- ([color=BLUE]mapcar[/color]
- '([color=BLUE]lambda[/color] ( x )
- ([color=BLUE]vl-remove[/color] [color=BLUE]nil[/color]
- ([color=BLUE]mapcar[/color]
- '([color=BLUE]lambda[/color] ( p )
- ([color=BLUE]vl-some[/color]
- '([color=BLUE]lambda[/color] ( a )
- ([color=BLUE]if[/color] ([color=BLUE]wcmatch[/color] ([color=BLUE]cadr[/color] a) p) a)
- )
- x
- )
- )
- '([color=MAROON]"REV#"[/color] [color=MAROON]"R#DESC"[/color] [color=MAROON]"R#BY"[/color] [color=MAROON]"R#CHK"[/color] [color=MAROON]"R#DATE"[/color])
- )
- )
- )
- (LM:groupbyfunction
- ([color=BLUE]mapcar[/color]
- '([color=BLUE]lambda[/color] ( a )
- ([color=BLUE]list[/color]
- ([color=BLUE]vl-list->string[/color]
- ([color=BLUE]vl-remove-if-not[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]<[/color] 47 x 58))
- ([color=BLUE]vl-string->list[/color] ([color=BLUE]vla-get-tagstring[/color] a))
- )
- )
- ([color=BLUE]strcase[/color] ([color=BLUE]vla-get-tagstring[/color] a))
- ([color=BLUE]vla-get-textstring[/color] a)
- ([color=BLUE]progn[/color] ([color=BLUE]vla-put-textstring[/color] a [color=MAROON]""[/color]) a)
- )
- )
- ([color=BLUE]vl-remove-if-not[/color]
- '([color=BLUE]lambda[/color] ( a )
- ([color=BLUE]wcmatch[/color] ([color=BLUE]strcase[/color] ([color=BLUE]vla-get-tagstring[/color] a))
- [color=MAROON]"REV#,R#DESC,R#BY,R#CHK,R#DATE"[/color]
- )
- )
- ([color=BLUE]vlax-invoke[/color]
- ([color=BLUE]vlax-ename->vla-object[/color] ([color=BLUE]ssname[/color] s ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i))))
- 'getattributes
- )
- )
- )
- ([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]=[/color] ([color=BLUE]car[/color] a) ([color=BLUE]car[/color] b)))
- )
- )
- '([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]>[/color] ([color=BLUE]caar[/color] a) ([color=BLUE]caar[/color] b)))
- )
- )
- ([color=BLUE]vl-remove-if[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]vl-every[/color] '([color=BLUE]lambda[/color] ( y ) ([color=BLUE]=[/color] [color=MAROON]""[/color] ([color=BLUE]caddr[/color] y))) x)) a)
- )
- )
- )
- ([color=BLUE]princ[/color])
- )
- [color=GREEN];; Group By Function - Lee Mac[/color]
- [color=GREEN];; Groups items considered equal by a given predicate function[/color]
- ([color=BLUE]defun[/color] LM:groupbyfunction ( lst fun [color=BLUE]/[/color] tmp1 tmp2 x1 )
- ([color=BLUE]if[/color] ([color=BLUE]setq[/color] x1 ([color=BLUE]car[/color] lst))
- ([color=BLUE]progn[/color]
- ([color=BLUE]foreach[/color] x2 ([color=BLUE]cdr[/color] lst)
- ([color=BLUE]if[/color] (fun x1 x2)
- ([color=BLUE]setq[/color] tmp1 ([color=BLUE]cons[/color] x2 tmp1))
- ([color=BLUE]setq[/color] tmp2 ([color=BLUE]cons[/color] x2 tmp2))
- )
- )
- ([color=BLUE]cons[/color] ([color=BLUE]cons[/color] x1 ([color=BLUE]reverse[/color] tmp1)) (LM:groupbyfunction ([color=BLUE]reverse[/color] tmp2) fun))
- )
- )
- )
- ([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])
快速演示: |