（XD::Polyline:FindSame）发现相同形状（顶点相对位置相同）的多段线

Lispboy

1. (defun xd::polyline:findsame (e / lst ptmin pts pts1 ss v1 v2 verts x)
   
2.   (and (xdrx-object-iskindof e "AcDbPolyline")
   
3.        (setq verts (xdrx-getpropertyvalue e "numverts")
   
4.              ss           (ssget "x" (list (cons 0 "lwpolyline") (cons 90 verts)))
   
5.              pts   (xdrx-getpropertyvalue e "vertices")
   
6.              ptmin (XD::PNTS:MinX->MinY pts 1.0)
   
7.              ptmin (car ptmin)
   
8.              e           (XD::Polyline:ResetSTartPoint e ptmin)
   
9.              pts   (xdrx-getpropertyvalue e "vertices")
   
10.              pts1  (mapcar '(lambda (x) (mapcar '- x ptmin)) pts)
    
11.              lst   nil
    
12.              v1           (_getmin e)
    
13.              pts   (xdrx-getpropertyvalue e "vertices")
    
14.              lst   (cons (list e pts) lst)
    
15.        )
    
16.        (mapcar '(lambda        (x)
    
17.                   (if (not (equal e x))
    
18.                     (progn (setq v2 (_getmin x))
    
19.                            (if (equal v1 v2)
    
20.                              (setq lst
    
21.                                     (cons (list x (xdrx-getpropertyvalue x "vertices"))
    
22.                                           lst
    
23.                                     )
    
24.                              )
    
25.                            )
    
26.                     )
    
27.                   )
    
28.                 )
    
29.                (xdrx-pickset->ents ss)
    
30.        )
    
31.   )
    
32.   lst
    
33. )
    
34. 
    

(defun xd::polyline:findsame (e / lst ptmin pts pts1 ss v1 v2 verts x)<br />   (and (xdrx-object-iskindof e "AcDbPolyline")<br />        (setq verts (xdrx-getpropertyvalue e "numverts")<br />              ss           (ssget "x" (list (cons 0 "lwpolyline") (cons 90 verts)))<br />              pts   (xdrx-getpropertyvalue e "vertices")<br />              ptmin (XD::PNTS:MinX->MinY pts 1.0)<br />              ptmin (car ptmin)<br />              e           (XD::Polyline:ResetSTartPoint e ptmin)<br />              pts   (xdrx-getpropertyvalue e "vertices")<br />              pts1  (mapcar '(lambda (x) (mapcar '- x ptmin)) pts)<br />              lst   nil<br />              v1           (_getmin e)<br />              pts   (xdrx-getpropertyvalue e "vertices")<br />              lst   (cons (list e pts) lst)<br />        )<br />        (mapcar '(lambda        (x)<br />                   (if (not (equal e x))<br />                     (progn (setq v2 (_getmin x))<br />                            (if (equal v1 v2)<br />                              (setq lst<br />                                     (cons (list x (xdrx-getpropertyvalue x "vertices"))<br />                                           lst<br />                                     )<br />                              )<br />                            )<br />                     )<br />                   )<br />                 )<br />                (xdrx-pickset->ents ss)<br />        )<br />   )<br />   lst<br /> )<br /> <br />