【已解决】（指定起始点的相对最短路径连线）自交的多段线变成顶点不变的不自交的...

Lisphk

各位大师，如下图，自交的多段线，如何才能变成单独的一根，顶点不变的，不自交的多段线呢？

/db_自贡黄明儒_

你这个有什么实际的使用吗？答案可能不止一种。其中一种是凸包，剩下的再凸包，由外往里绕。

Lisphk

/db_自贡黄明儒_ 发表于 2018-2-8 22:02

谢谢黄总回复，这个可以是解不走交叉路的遍历所有顶点。凸包好像不行吧，包来包去的还是有交叉，黄总给个代码？

Lisphk

/db_自贡黄明儒_ 发表于 2018-2-8 22:02

下面程序我想找到一些点的最短的路径，
下图是程序找到的从黄色点开始的，遍历所有顶点的最短的路径。但是有交叉，我想进一步的求出接近最短路径的不交叉的那条路径，所以用凸包那些是解决不了的。


84个点，程序找到的最短路径



337个点，程序找到的最短路径

1. (defun c:tt ()
   
2.   (if (setq ss (ssget '((0 . "point"))))
   
3.     (progn (setq pts nil
   
4.                  i   -1
   
5.            )
   
6.            (while (setq e (ssname ss (setq i (1+ i))))
   
7.              (setq pt  (cdr (assoc 10 (entget e)))
   
8.                    pts (cons pt pts)
   
9.              )
   
10.            );;收集顶点
    
11. 
    
12.            (setq pts  (cons '(0 0 0) pts)
    
13.                  pt   (car pts)
    
14.                  pts1 nil
    
15.            )
    
16.            (while (cdr pts)
    
17.              (setq mindis 1e10)
    
18.              (foreach n        pts
    
19.                (setq dis (distance pt n))
    
20.                (if (< dis mindis)
    
21.                  (setq mindis dis
    
22.                        ptmin n
    
23.                  )
    
24.                )
    
25.              )
    
26.              (setq pts1        (cons ptmin pts1)
    
27.                    pts        (vl-remove ptmin pts)
    
28.              )
    
29.              (setq pt ptmin)
    
30.            )
    
31.            (setq pts1 (cdr (reverse (cons (last pts) pts1))))
    
32.            (setq pts1 (mapcar '(lambda (x) (list 10 (car x) (cadr x))) pts1))
    
33.            (entmake (append (list '(0 . "LWPOLYLINE")
    
34.                                   '(100 . "AcDbEntity")
    
35.                                   '(410 . "Model")
    
36.                                   '(100 . "AcDbPolyline")
    
37.                                   (cons 90 (length pts1))
    
38.                             )
    
39.                             pts1
    
40.                     )
    
41.            )
    
42.     )
    
43.   )
    
44.   (princ)
    
45. )
    
46. 
    

(defun c:tt ()<br />   (if (setq ss (ssget '((0 . "point"))))<br />     (progn (setq pts nil<br />                  i   -1<br />            )<br />            (while (setq e (ssname ss (setq i (1+ i))))<br />              (setq pt  (cdr (assoc 10 (entget e)))<br />                    pts (cons pt pts)<br />              )<br />            );;收集顶点<br /> <br />            (setq pts  (cons '(0 0 0) pts)<br />                  pt   (car pts)<br />                  pts1 nil<br />            )<br />            (while (cdr pts)<br />              (setq mindis 1e10)<br />              (foreach n        pts<br />                (setq dis (distance pt n))<br />                (if (< dis mindis)<br />                  (setq mindis dis<br />                        ptmin n<br />                  )<br />                )<br />              )<br />              (setq pts1        (cons ptmin pts1)<br />                    pts        (vl-remove ptmin pts)<br />              )<br />              (setq pt ptmin)<br />            )<br />            (setq pts1 (cdr (reverse (cons (last pts) pts1))))<br />            (setq pts1 (mapcar '(lambda (x) (list 10 (car x) (cadr x))) pts1))<br />            (entmake (append (list '(0 . "LWPOLYLINE")<br />                                   '(100 . "AcDbEntity")<br />                                   '(410 . "Model")<br />                                   '(100 . "AcDbPolyline")<br />                                   (cons 90 (length pts1))<br />                             )<br />                             pts1<br />                     )<br />            )<br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:最短路径.rar 
下载次数:60  文件大小:32.43 KB 
下载权限: 不限 以上  [免费赚D豆]

434939575

外框bo行不&#128513;

auva

chlh_jd前辈的帖子：点集最短回路（TSP问题）讨论

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

marting

找起点出来的第一个交叉点分析

1、8,9段 和15，16段交叉
2、图中可以看到，第二个线段的起点15和第一个线段的终点9 之间的 顺序互换，15变成9,14变成13...9变成15，然后 8 和 原来的15相连，原来的9（15）和原来的16相连，就变成不交叉的通路了。

所以，程序需要找出交叉段的起点索引和端点索引，然后交换， 下面每次遇到的都相同处理。

sicky111

谢谢分享。

追风lisp

谢谢分享~！

marting

Lisphk 发表于 2018-2-8 23:40

用上面分析的，写了代码，试试，你那个337个点的图变成这样了

之前：



之后：





XD::List:Nth-- 、XD::List:Nth++ 函数见：

• （XD::List:Nth--）返回表指定位置s之前，长度n的子表（不包括s）
• （XD::List:Nth++）返回表指定位置开始，长度n的子表
  

1. (defun c:tt ()
   
2.   (defun _reverse_swap (pts from to)
   
3.     (setq lst0 (XD::List:Nth-- pts from nil)
   
4.           lst1 (XD::List:Nth++ pts from (1+ (- to from)))
   
5.           lst2 (XD::List:Nth++ pts (1+ to) nil)
   
6.     )
   
7.     (append lst0 (reverse lst1) lst2)
   
8.   )
   
9.   (defun _entmake (pts)
   
10.     (setq pts1 (mapcar '(lambda (x) (list 10 (car x) (cadr x))) pts))
    
11.     (entmake (append (list '(0 . "LWPOLYLINE")
    
12.                            '(100 . "AcDbEntity")
    
13.                            '(410 . "Model")
    
14.                            '(100 . "AcDbPolyline")
    
15.                            (cons 90 (length pts1))
    
16.                      )
    
17.                      pts1
    
18.              )
    
19.     )
    
20.     (entlast)
    
21.   )
    
22.   (if (setq e (car (entsel "\n拾取多段线<退出>:")))
    
23.     (progn
    
24.       (vla-startundomark
    
25.         (setq doc (vla-get-activedocument (vlax-get-acad-object)))
    
26.       )
    
27.       (setq pts (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget e))
    
28.             pts (mapcar 'cdr pts)
    
29.       )
    
30.       (setq i   0
    
31.             len (length pts)
    
32.       )
    
33.       (setq bHadCrossingSegments t
    
34.             bself nil
    
35.             bar 0
    
36.       )
    
37.       (while (< i (1- len))
    
38.         (setq p1 (nth i pts))
    
39.         (setq p2 (nth (1+ i) pts))
    
40.         (setq j  0
    
41.               tf t
    
42.         )
    
43.         (if (= bar 0)
    
44.           (progn (princ "\n") (setq bar (1+ bar)))
    
45.         )
    
46.         (princ
    
47.           (strcat "\r当前进度:" (rtos (* 100 (/ i len 1.0)) 2 0) "%")
    
48.         )
    
49.         (princ)
    
50.         (while (and tf (< j (1- len)))
    
51.           (setq p_1 (nth j pts))
    
52.           (setq p_2 (nth (1+ j) pts))
    
53.           (if (and (not (equal p1 p_1 1e-3))
    
54.                    (not (equal p1 p_2 1e-3))
    
55.                    (not (equal p2 p_1 1e-3))
    
56.               )
    
57.             (progn (if (setq ints (inters p1 p2 p_1 p_2))
    
58.                      (progn (if (> i j)
    
59.                               (setq from (1+ j)
    
60.                                     to   i
    
61.                               )
    
62.                               (setq from (1+ i)
    
63.                                     to   j
    
64.                               )
    
65.                             )
    
66.                             (setq pts (_reverse_swap pts from to))
    
67.                             (setq bHadCrossingSegments t
    
68.                                   bself t
    
69.                             )
    
70.                      )
    
71.                    )
    
72.             )
    
73.           )
    
74.           (if bHadCrossingSegments
    
75.             (setq tf nil)
    
76.           )
    
77.           (setq j (1+ j))
    
78.         )
    
79.         (setq i (1+ i))
    
80.         (if bHadCrossingSegments
    
81.           (setq i (min (max (1- i) 0) (max j 0))
    
82.                 bHadCrossingSegments nil
    
83.           )
    
84.         )
    
85.       )
    
86.       (if bself
    
87.         (progn (entdel e) (_entmake pts))
    
88.       )
    
89.       (princ "\r当前进度:100%")
    
90.       (vla-endundomark doc)
    
91.     )
    
92.   )
    
93.   (princ)
    
94. )

(defun c:tt ()<br />   (defun _reverse_swap (pts from to)<br />     (setq lst0 (XD::List:Nth-- pts from nil)<br />           lst1 (XD::List:Nth++ pts from (1+ (- to from)))<br />           lst2 (XD::List:Nth++ pts (1+ to) nil)<br />     )<br />     (append lst0 (reverse lst1) lst2)<br />   )<br />   (defun _entmake (pts)<br />     (setq pts1 (mapcar '(lambda (x) (list 10 (car x) (cadr x))) pts))<br />     (entmake (append (list '(0 . "LWPOLYLINE")<br />                            '(100 . "AcDbEntity")<br />                            '(410 . "Model")<br />                            '(100 . "AcDbPolyline")<br />                            (cons 90 (length pts1))<br />                      )<br />                      pts1<br />              )<br />     )<br />     (entlast)<br />   )<br />   (if (setq e (car (entsel "\n拾取多段线<退出>:")))<br />     (progn<br />       (vla-startundomark<br />         (setq doc (vla-get-activedocument (vlax-get-acad-object)))<br />       )<br />       (setq pts (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget e))<br />             pts (mapcar 'cdr pts)<br />       )<br />       (setq i   0<br />             len (length pts)<br />       )<br />       (setq bHadCrossingSegments t<br />             bself nil<br />             bar 0<br />       )<br />       (while (< i (1- len))<br />         (setq p1 (nth i pts))<br />         (setq p2 (nth (1+ i) pts))<br />         (setq j  0<br />               tf t<br />         )<br />         (if (= bar 0)<br />           (progn (princ "\n") (setq bar (1+ bar)))<br />         )<br />         (princ<br />           (strcat "\r当前进度:" (rtos (* 100 (/ i len 1.0)) 2 0) "%")<br />         )<br />         (princ)<br />         (while (and tf (< j (1- len)))<br />           (setq p_1 (nth j pts))<br />           (setq p_2 (nth (1+ j) pts))<br />           (if (and (not (equal p1 p_1 1e-3))<br />                    (not (equal p1 p_2 1e-3))<br />                    (not (equal p2 p_1 1e-3))<br />               )<br />             (progn (if (setq ints (inters p1 p2 p_1 p_2))<br />                      (progn (if (> i j)<br />                               (setq from (1+ j)<br />                                     to   i<br />                               )<br />                               (setq from (1+ i)<br />                                     to   j<br />                               )<br />                             )<br />                             (setq pts (_reverse_swap pts from to))<br />                             (setq bHadCrossingSegments t<br />                                   bself t<br />                             )<br />                      )<br />                    )<br />             )<br />           )<br />           (if bHadCrossingSegments<br />             (setq tf nil)<br />           )<br />           (setq j (1+ j))<br />         )<br />         (setq i (1+ i))<br />         (if bHadCrossingSegments<br />           (setq i (min (max (1- i) 0) (max j 0))<br />                 bHadCrossingSegments nil<br />           )<br />         )<br />       )<br />       (if bself<br />         (progn (entdel e) (_entmake pts))<br />       )<br />       (princ "\r当前进度:100%")<br />       (vla-endundomark doc)<br />     )<br />   )<br />   (princ)<br /> )

kqqt6236

厉害了。     

Lisphk

marting 发表于 2018-2-9 19:48

谢谢老师，把你的代码和我的合到一起，写了个可以指定起始点的 相对最短路径的代码，自己想的，也不知道能贴到哪类算法里面去，代码要比网上看到的短很多，实用上可以了。

游客，如果您要查看本帖隐藏内容请回复

sicky111

楼主很牛哦！

aimisiyou

看图片好像还有更短的路径

aimisiyou

如果是在二次曲线上的一些点，那么很容易通过排序来获得最短路径。那么能否通过某种方式将其转换到二次曲线上呢？好像不对，变换不能保证长度同一变化。