[求助]求多条直线交点的个数的 相关问题

lgjoe

本人 不会编程 再网上找了 一个程序  是 求 直线交点个数的 程序，可是这个程序有个小的弊端，就是当多条直线交于同一点时，会分别重复计数，我的目的是重叠的交点只要记一个点的数，也就是把下面的程序里加入 过滤重叠点的 命令。希望哪位大侠帮忙改一下 ，如果另外重新写更方便的话，重写也可以。 万分感激。

下面是 程序代码：

(defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
(setq ax_ent_1 (vlax-ename->vla-object ent1)
ax_ent_2 (vlax-ename->vla-object ent2)
)
(setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
(setq intpoints (vlax-variant-value intpoints))
(setq i 0)
(if (> (vlax-safearray-get-u-bound intpoints 1) 0)
(repeat (/ (+ 1
(- (vlax-safearray-get-u-bound intpoints 1)
(vlax-safearray-get-l-bound intpoints 1)
)
)
3
)
(setq points (append points (list (list
   (vlax-safearray-get-element intpoints i)
   (vlax-safearray-get-element intpoints (+ i 1))
   (vlax-safearray-get-element intpoints (+ i 2))
   )))
)
(setq i (+ 3 i))
)
)
points
)

(defun c:main( / ss n i j ent1 ent2 points)
(setq ss (ssget))
(if ss
(setq n (sslength ss))
)
(setq i 0 j 0)
(while (< i n)
(setq j (1+ i))
(setq ent1 (ssname ss i))
(while (< j n)
(setq ent2 (ssname ss j))
(setq points (append points (getinterpoint ent1 ent2)))
(setq j (1+ j))
)
(setq i (1+ i))
)
(Princ points)
(princ (strcat "\n共有交点" (itoa (length points)) "个"))
(princ)
)

Saging

试下这个吧,不过只支持二维点.

2. (defun gp:sort-2(Lists m_max)
3.   ;筛选，保证数据无重复，m_max是一调整间隙的变量。在此应为0。
4.   (setq i (length lists))
5.   (setq LNew nil)
6.   (setq j 1)
7.   
8.   (while (<= j i);while start
9.     (setq a (car lists))
10.     (if (= a nil) (setq lists (cdr lists)))
11.     (if (/= a nil)
12.       (setq flag 0
13.      ltmp (cdr lists)
14.      m (length ltmp)
15.      n 1 ))
16.    
17.     (if (/= a nil)
18.       
19.       (while (<= n m);while start
20. (setq b (car ltmp))
22. (if (and (<= (abs (- (car a) (car b))) m_max) (<= (abs (- (cadr a) (cadr b))) m_max)) ;then
23.    (setq flag 1));end if   按间距过滤多余的直线(如果点A的X座标及Y座标与点B的X座标及Y座标之差的绝对值在间距变量之内侧过滤掉
24. ;上一行代码为第二版修改代码
26. (setq ltmp (cdr ltmp))
27. (setq n (1+ n))));end while
28.    
29.     (if (and (/= a nil)(= flag 0)) (setq LNew (append LNew (List a))));可用元素添加到新列表
30.     (setq j (1+ j))
31.     (setq lists (cdr lists))
32.   );end while
33.   LNew;返回处理好的列表。
34. );end function

(defun gp:sort-2(Lists m_max)   ;筛选，保证数据无重复，m_max是一调整间隙的变量。在此应为0。   (setq i (length lists))   (setq LNew nil)   (setq j 1)      (while (<= j i);while start     (setq a (car lists))     (if (= a nil) (setq lists (cdr lists)))     (if (/= a nil)       (setq flag 0      ltmp (cdr lists)      m (length ltmp)      n 1 ))         (if (/= a nil)              (while (<= n m);while start (setq b (car ltmp)) (if (and (<= (abs (- (car a) (car b))) m_max) (<= (abs (- (cadr a) (cadr b))) m_max)) ;then    (setq flag 1));end if   按间距过滤多余的直线(如果点A的X座标及Y座标与点B的X座标及Y座标之差的绝对值在间距变量之内侧过滤掉 ;上一行代码为第二版修改代码 (setq ltmp (cdr ltmp)) (setq n (1+ n))));end while         (if (and (/= a nil)(= flag 0)) (setq LNew (append LNew (List a))));可用元素添加到新列表     (setq j (1+ j))     (setq lists (cdr lists))   );end while   LNew;返回处理好的列表。 );end function

lgjoe

谢谢 我先试试看

lgjoe

2楼大哥啊  小弟是文盲  不好意思  我怎么不知道 这个程序的运行命令是什么啊

麻烦你给个提示啊  谢谢