004 发表于 2012-12-18 18:53:46

如何实现,对线段坐标排序,生成线顺序的顶点表?

题目:将一条多段线炸开,得到多条直线,提取直线的首尾(尾首)端点组成一个短线表,将所有短线表随机排列成一个大表lst,
要求:对lst排序得到原多段线有序的顶点表(不考虑方向).不能使用pedit

测试数据:
(setq lst '(((12 10 0) (14 7 0)) ((6 3 0) (10 4 0)) ((10 4 0) (14 7 0)) ((8 12 0) (12 10 0))))
结果:(((6 3 0) (10 4 0)) ((10 4 0) (14 7 0)) ((14 7 0) (12 10 0)) ((12 10 0) (8 12 0)))
或((6 3 0) (10 4 0) (14 7 0) (12 10 0) (8 12 0))

004 发表于 2012-12-18 21:58:56

本帖最后由 004 于 2012-12-18 23:13 编辑

Gu_xl 发表于 2012-12-18 20:27 static/image/common/back.gif


非常感谢G版主及时的回复,让我很激动,好好的拜读了,没敢轻易回复,做了一些变动请大侠过目.


;;可生成多条线点表.
(defun f1 (l / c)
(setq        a (car l)
        b (cdr l)
        c nil
)
(while (not (equal c b))
    (setq c b)
    (vl-some (function (lambda (x)
                       (cond ((equal (car a) (car x) 1e-6)
                                (setq b        (vl-remove x b)
                                      a        (cons (cadr x) a)
                                )
                             )
                             ((equal (car a) (cadr x) 1e-6)
                                (setq b        (vl-remove x b)
                                      a        (cons (car x) a)
                                )
                             )
                             ((equal (last a) (car x) 1e-6)
                                (setq b        (vl-remove x b)
                                      a        (append a (list (cadr x)))
                                )
                             )
                             ((equal (last a) (cadr x) 1e-6)
                                (setq b        (vl-remove x b)
                                      a        (append a (list (car x)))
                                )
                             )
                       )
                     )
             )
             b
    )
)
(setq ptlst (append ptlst (list a)))
(if b
    (f1 b)
)
)
(defun c:tt ()
(setq ptlst '())
(setq        lst '(((12 10 0) (14 7 0));_第一条线
              ((6 3 0) (10 4 0))
              ((10 4 0) (14 7 0))
              ((8 12 0) (12 10 0))
              ((100 200 0) (110 220 0));_第二条线
              ((110 220 0) (330 240 0))
              ((100 200 0) (80 70 0))
             )
)
(f1 lst)
ptlst;_返回
)
;;结果
;;(((8 12 0) (12 10 0) (14 7 0) (10 4 0) (6 3 0)) ((80 70 0) (100 200 0) (110 220 0) (330 240 0)))


Gu_xl 发表于 2012-12-18 20:27:02

本帖最后由 Gu_xl 于 2012-12-18 20:40 编辑


(defun f (l / f1 r)
(defun f1 (a b / c)
    (setq c b)
    (if b
      (vl-some '(lambda (x)
    (if (equal (car a) (car x) 1e-6)
      (setq b (vl-remove x b)
   a (cons (cadr x) a)
      )
      (if (equal (car a) (cadr x) 1e-6)
      (setq b (vl-remove x b)
       a (cons (car x) a)
      )
      )
    )
)
      b
      )
    )
    (if b
      (vl-some '(lambda (x)
    (if (equal (last a) (car x) 1e-6)
      (setq b (vl-remove x b)
   a (append a (list (cadr x)))
      )
      (if (equal (last a) (cadr x) 1e-6)
      (setq b (vl-remove x b)
       a (append a (list (car x)))
      )
      )
    )
)
      b
      )
    )
    (if (and
   b
   (/= b c)
   )
      (f1 a b)
      a
    )
)
(f1 (car l) (cdr l))
)

gzxl 发表于 2012-12-18 22:15:49

用来做什么的

004 发表于 2012-12-18 22:23:43

gzxl 发表于 2012-12-18 22:15 static/image/common/back.gif
用来做什么的

还是你说的,用每个三角网的短线连接生等高线线.G版的方法比我的好多了.

gzxl 发表于 2012-12-18 22:55:30

004 发表于 2012-12-18 22:23 static/image/common/back.gif
还是你说的,用每个三角网的短线连接生等高线线.G版的方法比我的好多了.

还在研究这个啊，都生成四边网了

004 发表于 2012-12-18 23:24:03

gzxl 发表于 2012-12-18 22:55 static/image/common/back.gif
还在研究这个啊，都生成四边网了

我还是一步一步的学习吧,你肯定是做测绘的,好多我感兴趣的帖子都有你的大名,我要步你的后尘了.

zyhandw 发表于 2012-12-19 08:33:22

好帖，来学习下
页: [1]
查看完整版本: 如何实现,对线段坐标排序,生成线顺序的顶点表?