[求助]：多義線上點集排序問題

taner

已知一點點集位於多義線上,請教怎樣將點按多義線的起點,點1 點2 點3...... 點n多義線終點的順序排序.
思路:
用(vlax-curve-getDistAtPoint splineObj getPt) 求各點離起點的距離,將點集按與起點的距離從小到排列.
但不知道怎麽實現.請大家指點一下.謝謝!

將EACHY版主的函數改一下:
http://www.xdcad.net/forum/showthread.php?s=&threadid=452597
說實話,eachy版主的這個東東我看得不是很明白.我只是依葫蘆畫瓢.

2. 
   
3.   [FONT=courier new]
   
4. (defun th1-getnearestpt (ename pts / ll p1 p2 d)
   
5.   (setq ll (vl-sort (mapcar
   
6.                       '(lambda (x)
   
7.                          (list (vlax-curve-getdistatpoint ename x) ename x)
   
8.                        )
   
9.                       pts
   
10.                     ) '(lambda (e1 e2)
    
11.                          (< (car e1) (car e2))
    
12.                        )
    
13.            )
    
14.   )
    
15.   (setq p1 (cdar ll)
    
16.         d (caar ll)
    
17.         ll (cdr ll)
    
18.   )
    
19.   (while (equal (car (setq p2 (car ll))) d 1e-5)
    
20.     (if (not (vl-position (last p2) p1))
    
21.       (setq p1 (append
    
22.                  p1
    
23.                  (list (last p2))
    
24.                )
    
25.       )
    
26.     )
    
27.     (setq ll (cdr ll))
    
28.   )
    
29.   p1
    
30. )
    
31. ;;;返回(ename 離起點正方向最近的點)
    
32. 
    
33.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun th1-getnearestpt (ename pts / ll p1 p2 d)<br />   (setq ll (vl-sort (mapcar<br />                       '(lambda (x)<br />                          (list (vlax-curve-getdistatpoint ename x) ename x)<br />                        )<br />                       pts<br />                     ) '(lambda (e1 e2)<br />                          (< (car e1) (car e2))<br />                        )<br />            )<br />   )<br />   (setq p1 (cdar ll)<br />         d (caar ll)<br />         ll (cdr ll)<br />   )<br />   (while (equal (car (setq p2 (car ll))) d 1e-5)<br />     (if (not (vl-position (last p2) p1))<br />       (setq p1 (append<br />                  p1<br />                  (list (last p2))<br />                )<br />       )<br />     )<br />     (setq ll (cdr ll))<br />   )<br />   p1<br /> )<br /> ;;;返回(ename 離起點正方向最近的點)<br /> <br />   [/FONT]<br />

从列表中移去指定的元素子程序:

2. 
   
3.   [FONT=courier new]  
   
4. (defun th-drop (lst item)
   
5.   (append
   
6.     (reverse (cdr (member item (reverse lst))))
   
7.     (cdr (member item lst))
   
8.   )
   
9. )
   
10.   [/FONT]
    

<br />   [FONT=courier new]  <br /> (defun th-drop (lst item)<br />   (append<br />     (reverse (cdr (member item (reverse lst))))<br />     (cdr (member item lst))<br />   )<br /> )<br />   [/FONT]<br />

將點集排序

2. 
   
3.   [FONT=courier new]
   
4. (defun th-getnin2maxpts (ename ptlist / k l nearestpt ptlistmin2max)
   
5.   (if (and
   
6.         ename
   
7.         ptlisti
   
8.       )
   
9.     (progn
   
10.       (setq k -1
    
11.             l (1- (length ptlisti))
    
12.       )
    
13.       (setq ptlistmin2max '())
    
14.       (while (< k l)
    
15.         (setq nearestpt (cadr (th1-getnearestpt ename ptlisti)))
    
16.         (setq ptlisti (th-drop ptlisti nearestpt))
    
17.         (setq ptlistmin2max (cons nearestpt ptlistmin2max))
    
18.         (setq k (1+ k))
    
19.       )
    
20.       (setq ptlistmin2max (reverse ptlistmin2max))
    
21.     )
    
22.   )
    
23. )
    
24. 
    
25.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun th-getnin2maxpts (ename ptlist / k l nearestpt ptlistmin2max)<br />   (if (and<br />         ename<br />         ptlisti<br />       )<br />     (progn<br />       (setq k -1<br />             l (1- (length ptlisti))<br />       )<br />       (setq ptlistmin2max '())<br />       (while (< k l)<br />         (setq nearestpt (cadr (th1-getnearestpt ename ptlisti)))<br />         (setq ptlisti (th-drop ptlisti nearestpt))<br />         (setq ptlistmin2max (cons nearestpt ptlistmin2max))<br />         (setq k (1+ k))<br />       )<br />       (setq ptlistmin2max (reverse ptlistmin2max))<br />     )<br />   )<br /> )<br /> <br />   [/FONT]<br />

eachy

2. 
   
3. ;;点集按Pl起点到终点排序，返回(pline实体 排序后的点表)
   
4. ;;参数 pl --- pline 实体或Object，pts ---- 点集
   
5. ;;其实 pl 可以是任何 Curve
   
6. (defun xdl-pts-sortonpl (pl pts)
   
7.   (setq        pts (mapcar '(lambda (x)
   
8.                        (list (vlax-curve-getparamatpoint
   
9.                                pl
   
10.                                (vlax-curve-getclosestpointto pl x)
    
11.                              )
    
12.                              x
    
13.                        )
    
14.                      )
    
15.                     pts
    
16.             )
    
17.         pts (vl-sort '(lambda (e1 e2) (< (car e1) (car e2))) pts)
    
18.   )
    
19.   (list pl (mapcar 'cadr pts))
    
20. )

<br /> ;;点集按Pl起点到终点排序，返回(pline实体 排序后的点表)<br /> ;;参数 pl --- pline 实体或Object，pts ---- 点集<br /> ;;其实 pl 可以是任何 Curve<br /> (defun xdl-pts-sortonpl (pl pts)<br />   (setq        pts (mapcar '(lambda (x)<br />                        (list (vlax-curve-getparamatpoint<br />                                pl<br />                                (vlax-curve-getclosestpointto pl x)<br />                              )<br />                              x<br />                        )<br />                      )<br />                     pts<br />             )<br />         pts (vl-sort '(lambda (e1 e2) (< (car e1) (car e2))) pts)<br />   )<br />   (list pl (mapcar 'cadr pts))<br /> )

taner

測試:
(xdl-pts-sortonpl (car(entsel))ptlistmin2max)

选择对象: ; 错误: 函数错误: 139.743

版主也有不小心的時候!vl-sort搞反了.

2. 
   
3.   [FONT=courier new]
   
4. (defun xdl-pts-sortonpl        (pl pts)
   
5.   (setq        pts (mapcar
   
6.               '(lambda (x)
   
7.                  (list (vlax-curve-getdistatpoint
   
8.                          pl
   
9.                          (vlax-curve-getclosestpointto pl x)
   
10.                        )
    
11.                        x
    
12.                  )
    
13.                )
    
14.               pts
    
15.             )
    
16.         pts (vl-sort pts
    
17.                      '(lambda (e1 e2)
    
18.                         (< (car e1) (car e2))
    
19.                       )
    
20.             )
    
21.   )
    
22.   (list        pl
    
23.         (mapcar
    
24.           'cadr
    
25.           pts
    
26.         )
    
27.   )
    
28. )  [/FONT]
    

<br />   [FONT=courier new]<br /> (defun xdl-pts-sortonpl        (pl pts)<br />   (setq        pts (mapcar<br />               '(lambda (x)<br />                  (list (vlax-curve-getdistatpoint<br />                          pl<br />                          (vlax-curve-getclosestpointto pl x)<br />                        )<br />                        x<br />                  )<br />                )<br />               pts<br />             )<br />         pts (vl-sort pts<br />                      '(lambda (e1 e2)<br />                         (< (car e1) (car e2))<br />                       )<br />             )<br />   )<br />   (list        pl<br />         (mapcar<br />           'cadr<br />           pts<br />         )<br />   )<br /> )  [/FONT]<br />

xyp1964

一个类似的函数：xyp-get-CurveIntersLeng  曲线交点表或交点间线长表

2. [FONT=courier new](load "xyp_lib.vlx");版本 V.20060122 (2003)
   
3. ;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)
   
4. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
   
5. ★1·在acad.lsp中增加(load"xyp_lib.vlx")
   
6. ■2·在每个程序内增加(load"xyp_lib.vlx")
   
7. ■3·在command下，输入(load"xyp_lib.vlx")
   
8. ■4·在菜单.mnl中增加(load"xyp_lib.vlx")
   
9. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
   
10. [COLOR=red] ★通用函数下载地址：[/COLOR]
    
11. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
    
12. |;
    
13. 
    
14. ;|★ xyp-get-CurveIntersLeng
    
15. 曲线交点表或交点间线长表
    
16. (xyp-get-CurveIntersLeng 实体名 mode)
    
17. mode:0,交点线长表;1,交点;2,线长
    
18. |;
    
19. 
    
20. (defun c:test ()
    
21.   (CMDLA0)
    
22.   (setq        s1 (car (entsel "\n选择曲线 : "))
    
23.         l0 (xyp-get-CurveIntersLeng s1 0)
    
24.         l1 (xyp-get-CurveIntersLeng s1 1)
    
25.         l2 (xyp-get-CurveIntersLeng s1 2)
    
26.   )
    
27.   (princ "\n交点线长表 = ")
    
28.   (princ l0)
    
29.   (princ "\n交点表 = ")
    
30.   (princ l1)
    
31.   (princ "\n线长表 = ")
    
32.   (princ l2)
    
33.   (CMDLA1)
    
34. )[/FONT]

[FONT=courier new](load "xyp_lib.vlx");版本 V.20060122 (2003)<br /> ;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)<br /> 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：<br /> ★1·在acad.lsp中增加(load"xyp_lib.vlx")<br /> ■2·在每个程序内增加(load"xyp_lib.vlx")<br /> ■3·在command下，输入(load"xyp_lib.vlx")<br /> ■4·在菜单.mnl中增加(load"xyp_lib.vlx")<br /> ■5·将xyp_lib.vlx文件直接拽到cad屏幕<br /> [COLOR=red] ★通用函数下载地址：[/COLOR]<br /> [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]<br /> |;<br /> <br /> ;|★ xyp-get-CurveIntersLeng<br /> 曲线交点表或交点间线长表<br /> (xyp-get-CurveIntersLeng 实体名 mode)<br /> mode:0,交点线长表;1,交点;2,线长<br /> |;<br /> <br /> (defun c:test ()<br />   (CMDLA0)<br />   (setq        s1 (car (entsel "\n选择曲线 : "))<br />         l0 (xyp-get-CurveIntersLeng s1 0)<br />         l1 (xyp-get-CurveIntersLeng s1 1)<br />         l2 (xyp-get-CurveIntersLeng s1 2)<br />   )<br />   (princ "\n交点线长表 = ")<br />   (princ l0)<br />   (princ "\n交点表 = ")<br />   (princ l1)<br />   (princ "\n线长表 = ")<br />   (princ l2)<br />   (CMDLA1)<br /> )[/FONT]

xyz518mm

那再请问一下这排序完如果要求出距离最大的第一段,第二段...并在做计算
该怎样作呢?