如何已知点表做各点连线（有连线规则）

kele99kele

在已知点表的情况下，如何做各点的规则连线呢？我现在连思路都没有，请帮忙看看。点表的数量为随机，但是肯定能够组成一个相对规则的形状。

Gu_xl

对点表进行排序即可！
水平方向的排序：
;;点自上而下，自左而右排序
      (setq pts (vl-sort pts '(lambda (a b) (if (equal (cadr a)(cadr b) 1e-3)(< (car a) (car b)) (> (cadr a)(cadr b))))))

      ;;点自左而右 自上而下排序
      (setq pts (vl-sort pts '(lambda (a b) (if (equal (car a)(car b) 1e-3)(> (cadr a) (cadr b)) (< (car a)(car b))))))
非水平方向的可先将点转换到水平方向，再排序，方法同上！

Gu_xl

;;加载XLRX_API后使用：

1. (defun c:tt (/ SS N PTS PTS1 L Y PTS2 X diff)
   
2.   (initget 4)
   
3.   (setq diff (getreal "\n输入容差值<0.001>"))
   
4.   (if (null diff) (setq diff 0.001))
   
5.   (if (setq ss (ssget '((0 . "point"))))
   
6.     (progn
   
7.       (repeat (setq n (sslength ss))
   
8.         (setq pts
   
9.                (cons (cdr (assoc 10 (entget (ssname ss (setq n (1- n))))))
   
10.                      pts
    
11.                )
    
12.         )
    
13.       )
    
14.       (setq m         (XLRX-Mat-SetCoordSystem
    
15.                    (setq o (getpoint "\n基点:"))
    
16.                    (setq v (mapcar '- (getpoint o "\n方向:") o))
    
17.                    (XLRX-Vec-perpVec v)
    
18.                  )
    
19.             invm (XLRX-Mat-Inverse m)
    
20.       )
    
21.       (setq pts (XLRX-Points-TransFormBy pts invm))
    
22.       ;;点自上而下，自左而右排序
    
23.       (setq pts1 (vl-sort pts
    
24.                           '(lambda (a b)
    
25.                              (if (equal (cadr a) (cadr b) diff)
    
26.                                (< (car a) (car b))
    
27.                                (> (cadr a) (cadr b))
    
28.                              )
    
29.                            )
    
30.                  )
    
31.       )
    
32.       (while pts1
    
33.         (setq l           (list (car pts1))
    
34.               pts1 (cdr pts1)
    
35.               y           (cadar pts1)
    
36.         )
    
37.         (while (and pts1 (equal y (cadar pts1) diff))
    
38.           (setq        l    (cons (car pts1) l)
    
39.                 pts1 (cdr pts1)
    
40.           )
    
41.         )
    
42.         (xlrx-make "lwpolyline" (XLRX-Points-TransFormBy l m))
    
43.       )
    
44. 
    
45.       ;;点自左而右 自上而下排序
    
46.       (setq pts2 (vl-sort pts
    
47.                           '(lambda (a b)
    
48.                              (if (equal (car a) (car b) diff)
    
49.                                (> (cadr a) (cadr b))
    
50.                                (< (car a) (car b))
    
51.                              )
    
52.                            )
    
53.                  )
    
54.       )
    
55.       (while pts2
    
56.         (setq l           (list (car pts2))
    
57.               pts2 (cdr pts2)
    
58.               x           (caar pts2)
    
59.         )
    
60.         (while (and pts2 (equal x (caar pts2) diff))
    
61.           (setq        l    (cons (car pts2) l)
    
62.                 pts2 (cdr pts2)
    
63.           )
    
64.         )
    
65.         (xlrx-make "lwpolyline" (XLRX-Points-TransFormBy l m))
    
66.       )
    
67.     )
    
68.   )
    
69. )
    
70. 
    

(defun c:tt (/ SS N PTS PTS1 L Y PTS2 X diff)<br />   (initget 4)<br />   (setq diff (getreal "\n输入容差值<0.001>"))<br />   (if (null diff) (setq diff 0.001))<br />   (if (setq ss (ssget '((0 . "point"))))<br />     (progn<br />       (repeat (setq n (sslength ss))<br />         (setq pts<br />                (cons (cdr (assoc 10 (entget (ssname ss (setq n (1- n))))))<br />                      pts<br />                )<br />         )<br />       )<br />       (setq m         (XLRX-Mat-SetCoordSystem<br />                    (setq o (getpoint "\n基点:"))<br />                    (setq v (mapcar '- (getpoint o "\n方向:") o))<br />                    (XLRX-Vec-perpVec v)<br />                  )<br />             invm (XLRX-Mat-Inverse m)<br />       )<br />       (setq pts (XLRX-Points-TransFormBy pts invm))<br />       ;;点自上而下，自左而右排序<br />       (setq pts1 (vl-sort pts<br />                           '(lambda (a b)<br />                              (if (equal (cadr a) (cadr b) diff)<br />                                (< (car a) (car b))<br />                                (> (cadr a) (cadr b))<br />                              )<br />                            )<br />                  )<br />       )<br />       (while pts1<br />         (setq l           (list (car pts1))<br />               pts1 (cdr pts1)<br />               y           (cadar pts1)<br />         )<br />         (while (and pts1 (equal y (cadar pts1) diff))<br />           (setq        l    (cons (car pts1) l)<br />                 pts1 (cdr pts1)<br />           )<br />         )<br />         (xlrx-make "lwpolyline" (XLRX-Points-TransFormBy l m))<br />       )<br /> <br />       ;;点自左而右 自上而下排序<br />       (setq pts2 (vl-sort pts<br />                           '(lambda (a b)<br />                              (if (equal (car a) (car b) diff)<br />                                (> (cadr a) (cadr b))<br />                                (< (car a) (car b))<br />                              )<br />                            )<br />                  )<br />       )<br />       (while pts2<br />         (setq l           (list (car pts2))<br />               pts2 (cdr pts2)<br />               x           (caar pts2)<br />         )<br />         (while (and pts2 (equal x (caar pts2) diff))<br />           (setq        l    (cons (car pts2) l)<br />                 pts2 (cdr pts2)<br />           )<br />         )<br />         (xlrx-make "lwpolyline" (XLRX-Points-TransFormBy l m))<br />       )<br />     )<br />   )<br /> )<br /> <br />

kele99kele

谢谢G版，我加到程序里试试看，热心的G版，32个赞

kele99kele

经测试，已解决，可否解释下容差的作用呢？

Gu_xl

kele99kele 发表于 2015-8-7 18:11
经测试，已解决，可否解释下容差的作用呢？

容差是指在同一水平线或垂直线的偏差

kele99kele

Gu_xl 发表于 2015-8-7 19:51
容差是指在同一水平线或垂直线的偏差

谢谢G版，看来我理解的没错

kele99kele

仔细研究了程序，G版的思路简单明了，转轴——排序——x向连线——y向连线，今天回来晚，看了G版的代码后茅塞顿开。

陨落

G版写过一个投影到圆上进行连线的程序，在特殊情况下可能会有用

陨落

http://bbs.mjtd.com/thread-88065-1-1.html