[编程交流] 比较两条多段线

[b][color=BLACK]([/color][/b]defun c:arepleq [b][color=FUCHSIA]([/color][/b]/ ss pl1 pl2 vn1 vn2 vd1 vd2
                      vl1 vl2 bl1 bl2 delta[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]or [b][color=MAROON]([/color][/b]not ss[b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]/= [b][color=GREEN]([/color][/b]sslength ss[b][color=GREEN])[/color][/b] 2[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]princ [color=#2f4f4f]"\nSelect 2 Polylines To Compare:   "[/color][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget '[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]0 . [color=#2f4f4f]"POLYLINE"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq pl1 [b][color=NAVY]([/color][/b]ssname ss 0[b][color=NAVY])[/color][/b]
       pl2 [b][color=NAVY]([/color][/b]ssname ss 1[b][color=NAVY])[/color][/b]
       vn1 [b][color=NAVY]([/color][/b]entnext pl1[b][color=NAVY])[/color][/b]
       vn2 [b][color=NAVY]([/color][/b]entnext pl2[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]/= [color=#2f4f4f]"SEQEND"[/color] [b][color=MAROON]([/color][/b]cdr [b][color=GREEN]([/color][/b]assoc 0 [b][color=BLUE]([/color][/b]entget vn1[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq vd1 [b][color=MAROON]([/color][/b]entget vn1[b][color=MAROON])[/color][/b]
              vl1 [b][color=MAROON]([/color][/b]cons [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 10 vd1[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] vl1[b][color=MAROON])[/color][/b]
              bl1 [b][color=MAROON]([/color][/b]cons [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 42 vd1[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] bl1[b][color=MAROON])[/color][/b]
              vn1 [b][color=MAROON]([/color][/b]entnext vn1[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]/= [color=#2f4f4f]"SEQEND"[/color] [b][color=MAROON]([/color][/b]cdr [b][color=GREEN]([/color][/b]assoc 0 [b][color=BLUE]([/color][/b]entget vn2[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq vd2 [b][color=MAROON]([/color][/b]entget vn2[b][color=MAROON])[/color][/b]
              vl2 [b][color=MAROON]([/color][/b]cons [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 10 vd2[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] vl2[b][color=MAROON])[/color][/b]
              bl2 [b][color=MAROON]([/color][/b]cons [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 42 vd2[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] bl2[b][color=MAROON])[/color][/b]
              vn2 [b][color=MAROON]([/color][/b]entnext vn2[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]if [b][color=NAVY]([/color][/b]= [b][color=MAROON]([/color][/b]length bl1[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]length bl2[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
     [b][color=NAVY]([/color][/b]progn
        [b][color=MAROON]([/color][/b]setq delta [b][color=GREEN]([/color][/b]mapcar '- [b][color=BLUE]([/color][/b]car vl1[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]car vl2[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
        [b][color=MAROON]([/color][/b]while [b][color=GREEN]([/color][/b]and vl1 vl2 delta[b][color=GREEN])[/color][/b]
               [b][color=GREEN]([/color][/b]cond [b][color=BLUE]([/color][/b][b][color=RED]([/color][/b]equal delta [b][color=PURPLE]([/color][/b]mapcar '- [b][color=TEAL]([/color][/b]car vl1[b][color=TEAL])[/color][/b] [b][color=TEAL]([/color][/b]car vl2[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] 1e-8[b][color=RED])[/color][/b]
                      [b][color=RED]([/color][/b]setq vl1 [b][color=PURPLE]([/color][/b]cdr vl1[b][color=PURPLE])[/color][/b]
                            vl2 [b][color=PURPLE]([/color][/b]cdr vl2[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                     [b][color=BLUE]([/color][/b]T [b][color=RED]([/color][/b]setq delta nil[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
        [b][color=MAROON]([/color][/b]foreach p bl1
           [b][color=GREEN]([/color][/b]if [b][color=BLUE]([/color][/b]not [b][color=RED]([/color][/b]equal [b][color=PURPLE]([/color][/b]car bl1[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]car bl2[b][color=PURPLE])[/color][/b] 1e-8[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
               [b][color=BLUE]([/color][/b]setq delta nil[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
           [b][color=GREEN]([/color][/b]setq bl1 [b][color=BLUE]([/color][/b]cdr bl1[b][color=BLUE])[/color][/b]
                 bl2 [b][color=BLUE]([/color][/b]cdr bl2[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]if delta
    [b][color=NAVY]([/color][/b]alert [color=#2f4f4f]"Polylines vertices and bulges are offsets"[/color][b][color=NAVY])[/color][/b]
    [b][color=NAVY]([/color][/b]alert [color=#2f4f4f]"Polylines vertices and bulges are not offsets"[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

(defun comparepline (pl1 pl2 / el1 el2 pt1 pt2 sw1 sw2 ew1 ew2 bu1 bu2 vec)
 (mapcar
   '(lambda (pl el pt sw ew bu)
      (set el (entget pl))
      (foreach p (eval el)
        (cond
          ((= 10 (car p)) (set pt (cons (cdr p) (eval pt))))
          ((= 40 (car p)) (set sw (cons (cdr p) (eval sw))))
          ((= 41 (car p)) (set ew (cons (cdr p) (eval ew))))
          ((= 42 (car p)) (set bu (cons (cdr p) (eval bu))))
        )
      )
    )
   (list pl1 pl2)
   '(el1 el2)
   '(pt1 pt2)
   '(sw1 sw2)
   '(ew1 ew2)
   '(bu1 bu2)
 )
 (setq vec (mapcar '- (car pt1) (car pt2)))
 (and
   (equal sw1 sw2)
   (equal ew1 ew2)
   (equal bu1 bu2)
   (equal pt1 (mapcar '(lambda (p) (mapcar '+ p vec)) pt2))
 )
)