发个函数，计算pllst中pline与pl0的重叠长度之和

张和平

2. (defun c:tttt( / pl0 pl i pllst overlen)
   
3.   (princ "\n>>> 选择主线")
   
4.   (setq pl0 (ssname (ssget '((0 . "*POLYLINE"))) 0))
   
5.   (princ (cdr (assoc 0 (entget pl0))))
   
6.   (princ "\n>>> 选择副线")
   
7.   (setq pl (ssget '((0 . "*POLYLINE"))) i 0)
   
8.   (repeat (sslength pl)
   
9.     (setq pllst (cons (ssname pl i) pllst) i (1+ i))
   
10.   )
    
11.   (setq overlen (PEACE:PL_OverLen pl0 pllst 10))
    
12.   (princ overlen)
    
13.   (princ)
    
14. )
    
15. 
    
16. 
    
17. ;;;计算pllst中pline与pl0的重叠长度之和  by peace 2013/08/20
    
18. ;;;pl0=主线图元名 pllst=副线图元名列表 maxd=最大距离，间距小于maxd即认为重合
    
19. ;;;遇相同图元，自动排除
    
20. (defun PEACE:PL_OverLen(pl0 pllst maxd / i j pl0obj ptlst pa pb pc overlen)
    
21.   (vl-load-com)
    
22.   (if (< maxd 0) (setq maxd 0))
    
23.   (cond
    
24.     (  ;若pl0不为pline，返回nil
    
25.       (and
    
26.         (/= (cdr (assoc 0 (entget pl0))) "POLYLINE")
    
27.         (/= (cdr (assoc 0 (entget pl0))) "LWPOLYLINE")
    
28.       )
    
29.       nil
    
30.     )
    
31.     (
    
32.       t
    
33.       (setq i 0 pl0obj (vlax-ename->vla-object pl0) overlen 0)
    
34.       (repeat (length pllst)
    
35.         (if (not (equal pl0 (nth i pllst)))
    
36.           (progn
    
37.             (setq ptlst (PEACE:Assoc_ItemList 10 (entget (nth i pllst)))
    
38.                       j 0
    
39.             )
    
40.             (repeat (1- (length ptlst))
    
41.               (setq pa (nth j ptlst)
    
42.                     pc (nth (1+ j) ptlst)
    
43.                     pb (mapcar '(lambda(a b) (* 0.5 (+ a b))) pa pc)
    
44.               )
    
45.               (if (and
    
46.                     (< (distance pa (vlax-curve-getClosestPointTo pl0obj pa)) maxd)
    
47.                     (< (distance pb (vlax-curve-getClosestPointTo pl0obj pb)) maxd)
    
48.                     (< (distance pc (vlax-curve-getClosestPointTo pl0obj pc)) maxd)  
    
49.                   )
    
50.                   (setq overlen (+ overlen (distance pa pc)))
    
51.               )
    
52.               (setq j (1+ j))
    
53.             )
    
54.           )
    
55.         )
    
56.         (setq i (1+ i))
    
57.       )
    
58.     )
    
59.   )
    
60.   overlen
    
61. )
    
62. ;;;获取表(Alist)中索引码(Item)相同的所有元素,并组成一个表(lst)返回
    
63. (defun PEACE:Assoc_ItemList (Item Alist / a lst)
    
64.   (while (setq a (assoc Item Alist))
    
65.     (setq  Alist (cdr (member a Alist)) ;cdr返回list(member a Alist)中除了第一个以外的所有元素的表
    
66.              lst (cons (cdr a) lst)
    
67.     )
    
68.   )
    
69.   (reverse lst) ;前面获得的坐标表是倒序的，现在再转换为正序
    
70. )

(defun c:tttt( / pl0 pl i pllst overlen)<br />   (princ "\n>>> 选择主线")<br />   (setq pl0 (ssname (ssget '((0 . "*POLYLINE"))) 0))<br />   (princ (cdr (assoc 0 (entget pl0))))<br />   (princ "\n>>> 选择副线")<br />   (setq pl (ssget '((0 . "*POLYLINE"))) i 0)<br />   (repeat (sslength pl)<br />     (setq pllst (cons (ssname pl i) pllst) i (1+ i))<br />   )<br />   (setq overlen (PEACE:PL_OverLen pl0 pllst 10))<br />   (princ overlen)<br />   (princ)<br /> )<br /> <br /> <br /> ;;;计算pllst中pline与pl0的重叠长度之和  by peace 2013/08/20<br /> ;;;pl0=主线图元名 pllst=副线图元名列表 maxd=最大距离，间距小于maxd即认为重合<br /> ;;;遇相同图元，自动排除<br /> (defun PEACE:PL_OverLen(pl0 pllst maxd / i j pl0obj ptlst pa pb pc overlen)<br />   (vl-load-com)<br />   (if (< maxd 0) (setq maxd 0))<br />   (cond <br />     (  ;若pl0不为pline，返回nil<br />       (and <br />         (/= (cdr (assoc 0 (entget pl0))) "POLYLINE")<br />         (/= (cdr (assoc 0 (entget pl0))) "LWPOLYLINE")<br />       )<br />       nil<br />     )<br />     (<br />       t<br />       (setq i 0 pl0obj (vlax-ename->vla-object pl0) overlen 0)<br />       (repeat (length pllst)<br />         (if (not (equal pl0 (nth i pllst)))<br />           (progn<br />             (setq ptlst (PEACE:Assoc_ItemList 10 (entget (nth i pllst)))<br />                       j 0<br />             )<br />             (repeat (1- (length ptlst))<br />               (setq pa (nth j ptlst) <br />                     pc (nth (1+ j) ptlst) <br />                     pb (mapcar '(lambda(a b) (* 0.5 (+ a b))) pa pc)<br />               )<br />               (if (and<br />                     (< (distance pa (vlax-curve-getClosestPointTo pl0obj pa)) maxd) <br />                     (< (distance pb (vlax-curve-getClosestPointTo pl0obj pb)) maxd)<br />                     (< (distance pc (vlax-curve-getClosestPointTo pl0obj pc)) maxd)  <br />                   )<br />                   (setq overlen (+ overlen (distance pa pc)))<br />               )<br />               (setq j (1+ j))<br />             )<br />           )<br />         )<br />         (setq i (1+ i))<br />       )<br />     )<br />   )<br />   overlen<br /> )<br /> ;;;获取表(Alist)中索引码(Item)相同的所有元素,并组成一个表(lst)返回<br /> (defun PEACE:Assoc_ItemList (Item Alist / a lst)<br />   (while (setq a (assoc Item Alist))<br />     (setq  Alist (cdr (member a Alist)) ;cdr返回list(member a Alist)中除了第一个以外的所有元素的表<br />              lst (cons (cdr a) lst)<br />     )<br />   )<br />   (reverse lst) ;前面获得的坐标表是倒序的，现在再转换为正序<br /> )

张和平

原理：以此判断pl1的每一段是否与pl0重合，若pl1的第i段的起点，中点和重点至pl0的距离均小于某一限值，那么即认为此段与pl0重合，然后此段长度计入重叠长度，以此类推。要求：pl0能基本包住pli
上个图：


由于算法的问题，如下图等的情况是不能正确计算的

newer

张和平 发表于 2013-8-22 16:02
原理：以此判断pl1的每一段是否与pl0重合，若pl1的第i段的起点，中点和重点至pl0的距离均小于某一限值，那 ...

楼主，最好还是上个图说明下，这个PL0没概念。

newer

张和平 发表于 2013-8-22 16:02
原理：以此判断pl1的每一段是否与pl0重合，若pl1的第i段的起点，中点和重点至pl0的距离均小于某一限值，那 ...

楼主，你上图都看着直晕，不上图的话，更云山雾罩了。

楼主，你最下的图算不出来的，是什么原因，算法不行那就修改下算法呗。这个图，你认为上面和下面和矩形贴的部分是重合的？ 你想计算这两个重叠部分的长度和？

张和平

newer 发表于 2013-8-22 23:50
楼主，你上图都看着直晕，不上图的话，更云山雾罩了。

楼主，你最下的图算不出来的，是什么原因，算法 ...

目前我所用到的是全贴合的，第二张图是部分贴合的，全贴合的话用我现在的算法就可以了，部分贴合的话要加一些判断条件，可以用二分法去求，稍微复杂一点，最近有点忙，所以就先没弄了。哈哈。。。。

xvjiex

感谢楼主分享函数，计算pllst中pline与pl0的重叠长度之和！