[编程交流] 直线和圆弧的排序列表

([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] cen cnt ent enx ept idx lst rad sel spt )
   ([color=BLUE]defun[/color] assocf ( x l f )
       ([color=BLUE]vl-some[/color] '([color=BLUE]lambda[/color] ( a ) ([color=BLUE]if[/color] ([color=BLUE]equal[/color] x ([color=BLUE]car[/color] a) f) a)) l)
   )
 
   ([color=BLUE]defun[/color] grouppoints ( l [color=BLUE]/[/color] a r x x1 x2 )
       ([color=BLUE]while[/color] ([color=BLUE]setq[/color] x ([color=BLUE]car[/color] l))
           ([color=BLUE]setq[/color] x ([color=BLUE]list[/color] x)
                 l ([color=BLUE]cdr[/color]  l)
           )
           ([color=BLUE]while[/color]
               ([color=BLUE]cond[/color]
                   (   ([color=BLUE]setq[/color] a (assocf ([color=BLUE]setq[/color] x1 ([color=BLUE]caar[/color] x)) l 1e-)
                       ([color=BLUE]setq[/color] x ([color=BLUE]cons[/color] ([color=BLUE]reverse[/color] a) x)
                             l ([color=BLUE]vl-remove[/color] a l)
                       )
                   )
                   (   ([color=BLUE]setq[/color] a (assocf ([color=BLUE]setq[/color] x2 ([color=BLUE]last[/color] ([color=BLUE]last[/color] x))) l 1e-)
                       ([color=BLUE]setq[/color] x ([color=BLUE]append[/color] x ([color=BLUE]list[/color] a))
                             l ([color=BLUE]vl-remove[/color] a l)
                       )
                   )
                   (   ([color=BLUE]setq[/color] a (assocf x1 ([color=BLUE]setq[/color] l ([color=BLUE]mapcar[/color] '[color=BLUE]reverse[/color] l)) 1e-)
                       ([color=BLUE]setq[/color] x ([color=BLUE]cons[/color] ([color=BLUE]reverse[/color] a) x)
                             l ([color=BLUE]vl-remove[/color] a l)
                       )
                   )
                   (   ([color=BLUE]setq[/color] a (assocf x2 l 1e-)
                       ([color=BLUE]setq[/color] x ([color=BLUE]append[/color] x ([color=BLUE]list[/color] a))
                             l ([color=BLUE]vl-remove[/color] a l)
                       )
                   )
               )
           )
           ([color=BLUE]setq[/color] r ([color=BLUE]cons[/color] x r))
       )
   )
   ([color=BLUE]defun[/color] amid ( c s e [color=BLUE]/[/color] v x )
       ([color=BLUE]setq[/color] v ([color=BLUE]mapcar[/color] '[color=BLUE]-[/color] e s)
             x ([color=BLUE]trans[/color] c 0 v)
       )
       ([color=BLUE]trans[/color] ([color=BLUE]cons[/color] ([color=BLUE]-[/color] ([color=BLUE]car[/color] x) ([color=BLUE]distance[/color] c s)) ([color=BLUE]cdr[/color] x)) v 0)
   )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] '((0 . [color=MAROON]"LINE,ARC"[/color]))))
       ([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]ssname[/color] sel ([color=BLUE]setq[/color] idx ([color=BLUE]1-[/color] idx)))
                     enx ([color=BLUE]entget[/color] ent)
               )
               ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]"LINE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 enx)))
                   ([color=BLUE]progn[/color]
                       ([color=BLUE]setq[/color] spt ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 enx))
                             ept ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 11 enx))
                       )
                       ([color=BLUE]if[/color] ([color=BLUE]equal[/color] ([color=BLUE]caddr[/color] spt) ([color=BLUE]caddr[/color] ept) 1e-
                           ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] ([color=BLUE]list[/color] spt ept) lst))
                       )
                   )
                   ([color=BLUE]setq[/color] cen ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 enx))
                         rad ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 40 enx))
                         spt ([color=BLUE]trans[/color] ([color=BLUE]polar[/color] cen ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 50 enx)) rad) ent 0)
                         ept ([color=BLUE]trans[/color] ([color=BLUE]polar[/color] cen ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 51 enx)) rad) ent 0)
                         lst ([color=BLUE]cons[/color]  ([color=BLUE]list[/color]  spt (amid ([color=BLUE]trans[/color] cen ent 0) spt ept) ept) lst)
                   )
               )
           )
           ([color=BLUE]setq[/color] cnt 0)
           ([color=BLUE]mapcar[/color]
               ([color=BLUE]function[/color]
                   ([color=BLUE]lambda[/color] ( grp )
                       ([color=BLUE]mapcar[/color]
                           ([color=BLUE]function[/color]
                               ([color=BLUE]lambda[/color] ( obj )
                                   ([color=BLUE]cons[/color] ([color=BLUE]setq[/color] cnt ([color=BLUE]1+[/color] cnt))
                                       ([color=BLUE]apply[/color] '[color=BLUE]append[/color] ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]list[/color] obj)))
                                   )
                               )
                           )
                           grp
                       )
                   )
               )
               (grouppoints lst)
           )
       )
   )
   ([color=BLUE]princ[/color])
)