lisp可以实现曲线上的点沿曲线排序吗？

tm20038175

1，前提是曲线上的点，点都在曲线上，或者距离曲线在容差范围内。
2，选择一批点，得到list点集。
3，按照距离曲线起点距离排序，得到新的list点集。
4，结束！…

ynhh

Gu_xl 发表于 2011-7-16 23:01
回复 tm20038175 的帖子

谢谢G版

露水2

可以 利用vlax-curve-getParamAtPoint

tm20038175

这个可能比较困难吧………

tm20038175

不知道有没有人这么做过。

mandala

很简单啊。

返回曲线从开始点到指定点的曲线段的长度

(vlax-curve-getDistAtPoint curve-obj point)
参数

curve-obj

要测量的 VLA 对象。

point

curve-obj 上的三维点表（在 WCS 中）。

返回值

如果成功则返回实数，否则返回 nil。

示例

在下例中，假定 splineObj 指向 vlax-curve-getDistAtParam 样例中的样条曲线。

设置 OSNAP 为“切点”并选择直线与曲线相切的点：

_$ (setq selPt (getpoint))
(4.91438 6.04738 0.0)
确定从曲线开始点到选定点的距离：

_$ (vlax-curve-getDistAtPoint splineObj selpt)
5.17769

Gu_xl

回复 tm20038175 的帖子

1. (defun SortPointByCurve (points curve / pl1 xx nn)
   
2.   (setq        pl1 (mapcar '(lambda (xx /)
   
3.                        (vlax-curve-getparamatpoint
   
4.                          curve
   
5.                          (vlax-curve-getclosestpointto curve xx)
   
6.                        )
   
7.                      )
   
8.                     points
   
9.             )
   
10.   )
    
11.   (mapcar '(lambda (nn) (nth nn points))
    
12.             (vl-sort-i pl1 '<)          
    
13.   )
    
14. )
    

(defun SortPointByCurve (points curve / pl1 xx nn)<br />   (setq        pl1 (mapcar '(lambda (xx /)<br />                        (vlax-curve-getparamatpoint<br />                          curve<br />                          (vlax-curve-getclosestpointto curve xx)<br />                        )<br />                      )<br />                     points<br />             )<br />   )<br />   (mapcar '(lambda (nn) (nth nn points))<br />             (vl-sort-i pl1 '<)          <br />   )<br /> )<br />

tm20038175

回复 Gu_xl 的帖子

哈哈，好人啦，谢谢呵~~~~
突发的想法，回头我要好好研究下~~~

tm20038175

回复 Gu_xl 的帖子

程序挺好的，能不能加一个带容差过滤重复点的功能呀，谢谢了………

jh1005

回复 tm20038175 的帖子

2. ;删除表中多余重复点(允许误差)
   
3. (defun del-rept (ptLst fuzz / pt1 x)
   
4.   ;pts:表  fuzz:精度
   
5.   (cond ((= (length ptLst) 1) ptLst)
   
6.   (t
   
7.    (setq pt1 (car ptLst))
   
8.    (cons pt1
   
9.    (vl-remove-if
   
10.      '(lambda (x) (equal pt1 x fuzz))
    
11.      (del-rept (cdr ptLst) fuzz)
    
12.    )
    
13.    )
    
14.   )
    
15.   )
    
16. )

;删除表中多余重复点(允许误差) <br /> (defun del-rept (ptLst fuzz / pt1 x)<br />   ;pts:表  fuzz:精度<br />   (cond ((= (length ptLst) 1) ptLst)<br />   (t<br />    (setq pt1 (car ptLst))<br />    (cons pt1<br />    (vl-remove-if<br />      '(lambda (x) (equal pt1 x fuzz))<br />      (del-rept (cdr ptLst) fuzz)<br />    )<br />    )<br />   )<br />   )<br /> )

tm20038175

回复 jh1005 的帖子

好程序，来的及时！
谢啦。。。。。。