求助：判断两点是否重叠

sunshinejwt

做的是建筑结构设计，画边缘构件（就像柱子一样的混凝土构件）的时候，需要对钢筋，就是自己标注的钢筋是否和详图一样。有时候两个钢筋不小心会画在一起，看起来像一个，其实在一个点上，画了两个钢筋点。本程序就是想校对出来，有没有钢筋点重合，重合的话，有几个重叠在一起。
自己编了一个lisp程序，可以运行不起来。请高手给指点一下。现在把图和lisp都传上。
(defun c:www ()

  (setq ss  (ssget '((0 . "lwpolyline")
                    (90 . 2)
                    (-4 . "<or")
                    (42 . 1)
                    (42 . -1)
                    (-4 . "or>")
                   )
           )
  )                                        ;构造针选择集
  (setq m 0)

  (if (/= ss nil)
    (progn
      (setq i% 0)
      (setq lenss1 (sslength ss))        ;获取选技集ss的长度
      (repeat (- lenss1 1)
        (setq ent1 (entget (ssname ss i%)));将第i%个图元属性附给ent1
        (setq r (assoc 10 ent1))
        (setq x1 (nth 1 r))
        (setq y1 (nth 2 r))
        (setq ii% (+ 1 i%))

         (repeat (- lenss1 ii%)
            (setq ent2 (entget (ssname ss ii%)));将第ii%个图元属性附给ent2
            (setq r1 (assoc 10 ent2))
            (setq x2 (nth 1 r1))
            (setq y2 (nth 2 r1))
            (setq x (expt (- x1 x2) 2))
            (setq y (expt (- y1 y2) 2))
            (if (=< (sqrt (+ x y)) r)
                (setq m (+ m 1))
            )
          )
       )
     )
   )
  (print (strcat "重叠钢筋数是" (rtos m)))
  (princ)
)

Lisphk

两个点重叠？ 用  equal 加上精度就可以了吧

st788796

使用 xd::list:groupby 分组，特征点就是 pline 第一点和第二点的中点，误差可以是 “圆” 半径

newer

截取下清晰的图片，贴上来，说明下情况吧，不是都有时间下载附件打开看的。
还有说明下，你钢筋是用什么实体画的， LWPOLYLINE？

marting

看不到图，可以用两个钢筋的实体的包围框相交状态判断是否重叠。

st788796

2. 
   
3. (defun c:tt (/ ss lst r s)
   
4.   (if (setq ss (ssget '((0 . "lwpolyline") (90 . 2) (-4 . "&=") (70 . 1))))
   
5.     (progn
   
6.       (setq lst        (mapcar        '(lambda (x / pts p)
   
7.                            (setq pts (xdrx_getpropertyvalue x "vertices")
   
8.                                  p   (xdrx_line_midp (cadr pts) (car pts))
   
9.                                  r   (distance (cadr pts) (car pts))
   
10.                            )
    
11.                            (list p x)
    
12.                          )
    
13.                         (xdrx_pickset->ents ss)
    
14.                 )
    
15.             lst        (xd::list:groupbyindex lst r)
    
16.       )
    
17.       (setq s (ssadd))
    
18.       (while lst
    
19.         (if (> (length (cdar lst)) 1)
    
20.           (foreach x (cdar lst)
    
21.             (ssadd x s))
    
22.         )
    
23.         (setq lst (cdr lst))
    
24.       )
    
25.       (sssetfirst nil s)
    
26.     )
    
27.   )
    
28.   (princ)
    
29. )

<br /> (defun c:tt (/ ss lst r s)<br />   (if (setq ss (ssget '((0 . "lwpolyline") (90 . 2) (-4 . "&=") (70 . 1))))<br />     (progn<br />       (setq lst        (mapcar        '(lambda (x / pts p)<br />                            (setq pts (xdrx_getpropertyvalue x "vertices")<br />                                  p   (xdrx_line_midp (cadr pts) (car pts))<br />                                  r   (distance (cadr pts) (car pts))<br />                            )<br />                            (list p x)<br />                          )<br />                         (xdrx_pickset->ents ss)<br />                 )<br />             lst        (xd::list:groupbyindex lst r)<br />       )<br />       (setq s (ssadd))<br />       (while lst<br />         (if (> (length (cdar lst)) 1)<br />           (foreach x (cdar lst)<br />             (ssadd x s))<br />         )<br />         (setq lst (cdr lst))<br />       )<br />       (sssetfirst nil s)<br />     )<br />   )<br />   (princ)<br /> )

newer

替你截下图，图中哪个地方是你要查的重叠？

csharp

圆点 不重叠

sunshinejwt

首先谢谢各位，很感动。估计是我问题说的不够清楚。现在截图说明一下。边缘构件表中上边是详图，下边是构件的名称、标高、纵向钢筋、箍筋。第三项是纵向钢筋，为了表达方便，有时候会标注（实心）或（空心）。我现在已经编了一个可以数钢筋的小程序。可以统计出详图中有几个实心和几个空心的小圆点。问题是有时候给别人校对图纸，他们有时会在同一个位置放两个小圆点。这样统计出来的就是错误的数字。所以才想编一个程序，来校对是否有重叠的钢筋。现在把详图框的图元信息和实心、空心的图元信息都生成了，方便各位大神指导小弟。另外还有一个想法，就是现在编的程序每次都只能校对其中一个方框里的内容，看看能不能整体选择，批量校对。处理后的效果就是在框的左上方写出校对的结果。请各位多多帮忙了。谢谢！

sunshinejwt

我自己编的程序如下(defun c:ww ( / 　 ent i% lenss1 m n)

  (setq        ss (ssget '((0 . "lwpolyline")
                    (90 . 2)
                    (-4 . "<or")
                    (42 . 1)
                    (42 . -1)
                    (-4 . "or>")
                   )
           )
  )                                        ;构造针选择集
  (setq m 0)
  (setq n 0)
  (if (/= ss nil)
    (progn
      (setq i% 0)
      (setq lenss1 (sslength ss))        ;获取选技集ss的长度

      (repeat lenss1
        (setq ent (entget (ssname ss i%)))
        　                                ;将第i%个图元属性附给ent
        (if (> (cdr (assoc 43 ent)) 0)
            (setq m (+ 1 m))
            (setq n (+ 1 n))
        )
       
        (setq i% (1+ i%))
      )
      ;(print (strcat "实心钢筋数是" (rtos m) "◆空心钢筋数是" (rtos n)))
      (alert (strcat "实心钢筋数是【 " (rtos m) " 】 ◆  空心钢筋数是【 " (rtos n) " 】"))

    )
  )
  (princ)
)
希望能用lisp语言+vlisp，因为公司电脑有设定，C盘的内容改变不了，没法装别的程序。只能是把插件放到别的盘，加载使用。

sunshinejwt

回复7楼，就是这个图片上看着是六个小圆点，其实有的一个小圆点地方，放了两个，除非移开一个才能发现是两个或者更多。我的想法是通过找到每个图元的圆心，然后通过两个圆心的距离来判断是否重叠，只要两个圆心的距离小于半径，那就判断重叠。其实只要两个小圆点有稍微大一点的距离，就能发现同一个位置有两个小圆点，就怕是两个真的重叠在一起，看是看不出来的。

st788796

思路给你了，自己修改下就不用 xdapi 了, xd::list:groupbyindex 在开源函数库找

2. 
   
3. (vl-load-com)
   
4. (defun c:tt (/ ss lst r s)
   
5.   (defun ss->ents (ss / sl i l)
   
6.     (setq sl (sslength ss)
   
7.           i  0
   
8.     )
   
9.     (while (< i sl)
   
10.       (setq l (cons (ssname ss i) l)
    
11.             i (1+ i)
    
12.       )
    
13.     )
    
14.     l
    
15.   )
    
16.   (if (setq ss (ssget '((0 . "lwpolyline") (90 . 2) (-4 . "&=") (70 . 1))))
    
17.     (progn
    
18.       (setq lst        (mapcar        '(lambda (x / sp ep p)
    
19.                            (setq sp (vlax-curve-getstartpoint x)
    
20.                                  ep (vlax-curve-getpointatparam x 1)
    
21.                                  p  (polar sp
    
22.                                            (angle sp ep)
    
23.                                            (* (distance sp ep) 0.5)
    
24.                                     )
    
25.                                  r
    
26.                                     (distance sp ep)
    
27.                            )
    
28.                            (list p x)
    
29.                          )
    
30.                         (ss->ents ss)
    
31.                 )
    
32.             lst        (xd::list:groupbyindex lst r)
    
33.       )
    
34.       (setq s (ssadd))
    
35.       (while lst
    
36.         (if (> (length (cdar lst)) 1)
    
37.           (foreach x (cdar lst)
    
38.             (ssadd x s)
    
39.           )
    
40.         )
    
41.         (setq lst (cdr lst))
    
42.       )
    
43.       (sssetfirst nil s)
    
44.     )
    
45.   )
    
46.   (princ)
    
47. )
    

<br /> (vl-load-com)<br /> (defun c:tt (/ ss lst r s)<br />   (defun ss->ents (ss / sl i l)<br />     (setq sl (sslength ss)<br />           i  0<br />     )<br />     (while (< i sl)<br />       (setq l (cons (ssname ss i) l)<br />             i (1+ i)<br />       )<br />     )<br />     l<br />   )<br />   (if (setq ss (ssget '((0 . "lwpolyline") (90 . 2) (-4 . "&=") (70 . 1))))<br />     (progn<br />       (setq lst        (mapcar        '(lambda (x / sp ep p)<br />                            (setq sp (vlax-curve-getstartpoint x)<br />                                  ep (vlax-curve-getpointatparam x 1)<br />                                  p  (polar sp<br />                                            (angle sp ep)<br />                                            (* (distance sp ep) 0.5)<br />                                     )<br />                                  r<br />                                     (distance sp ep)<br />                            )<br />                            (list p x)<br />                          )<br />                         (ss->ents ss)<br />                 )<br />             lst        (xd::list:groupbyindex lst r)<br />       )<br />       (setq s (ssadd))<br />       (while lst<br />         (if (> (length (cdar lst)) 1)<br />           (foreach x (cdar lst)<br />             (ssadd x s)<br />           )<br />         )<br />         (setq lst (cdr lst))<br />       )<br />       (sssetfirst nil s)<br />     )<br />   )<br />   (princ)<br /> )<br />

sunshinejwt

谢谢提供思路，现在正在研究。

newer

sunshinejwt 发表于 2017-6-8 10:41

有心得就来跟帖和大家交流

sunshinejwt

好的，刚开始学习lisp，也会把自己的学习心得和大家交流。