[LISP函数]：点集按Pl起点到终点排序

taner

2. 
   
3.   [FONT=courier new]
   
4. ;;点集按Pl起点到终点排序，返回(pline实体 排序后的点表)
   
5. ;;参数 pl --- pline 实体或Object，pts ---- 点集
   
6. ;;其实 pl 可以是任何 Curve
   
7. ;;by Eachy
   
8. (defun xdl-pts-sortonpl        (pl pts)
   
9.   (setq        pts (mapcar
   
10.               '(lambda (x)
    
11.                  (list (vlax-curve-getdistatpoint
    
12.                          pl
    
13.                          (vlax-curve-getclosestpointto pl x)
    
14.                        )
    
15.                        x
    
16.                  )
    
17.                )
    
18.               pts
    
19.             )
    
20.         pts (vl-sort pts
    
21.                      '(lambda (e1 e2)
    
22.                         (< (car e1) (car e2))
    
23.                       )
    
24.             )
    
25.   )
    
26.   (list        pl
    
27.         (mapcar
    
28.           'cadr
    
29.           pts
    
30.         )
    
31.   )
    
32. )
    
33.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;;点集按Pl起点到终点排序，返回(pline实体 排序后的点表)<br /> ;;参数 pl --- pline 实体或Object，pts ---- 点集<br /> ;;其实 pl 可以是任何 Curve<br /> ;;by Eachy<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 /> )<br />   [/FONT]<br />

小菜

论坛上有的是用vlax-curve-getdistatpoint函数计算距离，有的地方用vlax-curve-getParamAtDist计算，这两个函数有什么不同呢？

GTJ116600

呵呵，看来研究eachy很早就研究这个问题。

yxh1202

能给个实例吗。

我按照你的来没有实现
(vl-load-com)
;;点集按Pl起点到终点排序，返回(pline实体 排序后的点表)
;;参数 pl --- pline 实体或Object，pts ---- 点集
;;其实 pl 可以是任何 Curve
;;by Eachy
(defun xdl-pts-sortonpl (pl pts)
  (setq pts (mapcar
       '(lambda (x)
   (list (vlax-curve-getdistatpoint
    pl
    (vlax-curve-getclosestpointto pl x)
         )
         x
   )
        )
       pts
     )
pts (vl-sort pts
       '(lambda (e1 e2)
   (< (car e1) (car e2))
        )
     )
  )
  (list pl
(mapcar
   'cadr
   pts
)
  )
)
;;;=============================================================
;;;测试
(defun C:hdm (/ S1 S2 I SIZE)
  (setq en (entsel "选择一条直线:"))
  (setq size 0)
  (SETQ S1 (ssget '((0 . "POINT"))))
  (SETQ n 0)
  (repeat (sslength s1)
    (setq lst (cons (ssname s1 n) lst)
   n   (1+ n)
    )
  )

  (setq
    x (mapcar '(lambda (x) (car (cdr (assoc 10 (entget x))))) lst)
  )
  (setq
    y (mapcar '(lambda (x) (cadr (cdr (assoc 10 (entget x)))))
       lst
      )
  )
  (setq maxx (eval (cons 'max x))
minx (eval (cons 'min x))
  )
  (setq maxy (eval (cons 'max y))
miny (eval (cons 'min y))
  )
  (setq dx (- maxx minx)
dy (- maxy miny)
  )
  ;;排序：
  (setq S2 (xdl-pts-sortonpl en lst))
  (progn
    (setq I 0)
    (repeat (sslength S2)
      (setq pen_data (entget (ssname s2 i)))
      (setq ppt (assoc 10 pen_data))
      (setq pp (cdr ppt))
      (setq Perpt (vlax-curve-getClosestPointTo (car en) pp T))
     ;找出垂点
      (entmake (APPEND '((0 . "LINE")
    (100 . "AcDbEntity")
    (100 . "AcDbLine")
    (8 . "0")
   )
         (LIST (CONS 10 pp) (CONS 11 perpt))
        )
      )
      (princ "\n")
      (princ (cdddr (assoc 10 (entget (ssname S2 I)))))
     ;显示排序结果。
      (setq I (1+ I))
    )
  )
  (princ)
)

maker_lv

好程序，mapcar真是个好函数

kkt123

好程序，mapcar真是个好函数;P