（XD::Entity:FindSame）发现相同（拷贝）的实体

Lispboy

1. (defun XD::Entity:FindSame (e / lst typ ss strp strp1 box box1)
   
2.   (setq typ (cdr (assoc 0 (entget e))))
   
3.   (if (setq ss (ssget "x" (list (cons 0 typ))))
   
4.     (progn
   
5.       (setq strp (xdrx-getpropertyvalue e "stretchpoint")
   
6.             strp (mapcar '(lambda (x) (mapcar '- x (car strp)))strp)
   
7.             box         (xdrx-entity-box e)
   
8.             box         (mapcar '(lambda (x) (mapcar '- x (xd::geom:get9pt box 5))) box)
   
9.       )
   
10.       (setq lst nil)
    
11.       (mapcar '(lambda (x)
    
12.                  (setq strp1 (xdrx-getpropertyvalue x "stretchpoint")
    
13.                        strp1 (mapcar '(lambda (x) (mapcar '- x (car strp1)))strp1)
    
14.                        box1  (xdrx-entity-box x)
    
15.                        box1  (mapcar '(lambda (x) (mapcar '- x (xd::geom:get9pt box1 5))) box1)
    
16.                  )
    
17.                  (if (and (equal strp strp1 1e-3) (equal box box1 1e-3))
    
18.                    (setq lst (cons x lst))
    
19.                  )
    
20.                )
    
21.               (xdrx-pickset->ents ss)
    
22.       )
    
23.     )
    
24.   )
    
25.   lst
    
26. )
    
27. 
    

(defun XD::Entity:FindSame (e / lst typ ss strp strp1 box box1)<br />   (setq typ (cdr (assoc 0 (entget e))))<br />   (if (setq ss (ssget "x" (list (cons 0 typ))))<br />     (progn<br />       (setq strp (xdrx-getpropertyvalue e "stretchpoint")<br />             strp (mapcar '(lambda (x) (mapcar '- x (car strp)))strp)<br />             box         (xdrx-entity-box e)<br />             box         (mapcar '(lambda (x) (mapcar '- x (xd::geom:get9pt box 5))) box)<br />       )<br />       (setq lst nil)<br />       (mapcar '(lambda (x)<br />                  (setq strp1 (xdrx-getpropertyvalue x "stretchpoint")<br />                        strp1 (mapcar '(lambda (x) (mapcar '- x (car strp1)))strp1)<br />                        box1  (xdrx-entity-box x)<br />                        box1  (mapcar '(lambda (x) (mapcar '- x (xd::geom:get9pt box1 5))) box1)<br />                  )<br />                  (if (and (equal strp strp1 1e-3) (equal box box1 1e-3))<br />                    (setq lst (cons x lst))<br />                  )<br />                )<br />               (xdrx-pickset->ents ss)<br />       )<br />     )<br />   )<br />   lst<br /> )<br /> <br />

wzjck01

学习，学习

Le9988

太感谢了。。。。。。。。

wzjck01

好东西 学习学习