点表按最近点相连排序

ynhh · 发表于 2022-1-29 22:09:14

求从点表任一端的起点开始，按最近点相连排序

从黄点两点中任一点开始，将全部点按最近相连接排序后

自动画通过所有点的多段线连接

xyp1964 · 发表于 2022-1-29 22:09:15

ynhh 发表于 2022-2-3 16:16
谢谢院长指导
您这个和
http://huojibk.com/2020/10/488.html

(defun c:tt () ; tt(最近点连线)
(if (setq ss (ssget '((0 . "point"))))
(progn
(setq lst (xyp-Ss2List ss)
ss1 (ssget "P" '((0 . "point") (62 . 2)))
lst2 (vl-sort (xyp-Ss2List ss1)
'(lambda (x y)
(> (cadr (xyp-DXF 10 x)) (cadr (xyp-DXF 10 y)))
)
)
s1 (car lst2)
lst (vl-remove s1 lst)
lst1 (list s1)
)
(while lst
(setq p0 (xyp-DXF 10 s1)
lst (vl-sort lst
'(lambda (x y)
(< (distance (xyp-DXF 10 x) p0)
(distance (xyp-DXF 10 y) p0)
)
)
)
s1 (car lst)
lst (cdr lst)
lst1 (cons s1 lst1)
)
)
(setq ptn (mapcar '(lambda (x) (xyp-DXF 10 x)) (reverse lst1)))
(xyp-Pline ptn nil)
)
)
(princ)
)

(defun c:tt () ; tt(最近点连线) 
 (if (setq ss (ssget '((0 . "point")))) 
  (progn 
   (setq lst  (xyp-Ss2List ss) 
         ss1  (ssget "P" '((0 . "point") (62 . 2))) 
         lst2 (vl-sort (xyp-Ss2List ss1) 
                       '(lambda (x y) 
                         (> (cadr (xyp-DXF 10 x)) (cadr (xyp-DXF 10 y))) 
                        ) 
              ) 
         s1   (car lst2) 
         lst  (vl-remove s1 lst) 
         lst1 (list s1) 
   ) 
   (while lst 
    (setq p0   (xyp-DXF 10 s1) 
          lst  (vl-sort lst 
                        '(lambda (x y) 
                          (< (distance (xyp-DXF 10 x) p0) 
                             (distance (xyp-DXF 10 y) p0) 
                          ) 
                         ) 
               ) 
          s1   (car lst) 
          lst  (cdr lst) 
          lst1 (cons s1 lst1) 
    ) 
   ) 
   (setq ptn (mapcar '(lambda (x) (xyp-DXF 10 x)) (reverse lst1))) 
   (xyp-Pline ptn nil) 
  ) 
 ) 
 (princ) 
)

tigcat · 发表于 2022-1-29 22:50:25

楼主多年前回过这个帖子
这有个速度不算快但能用的帖子
http://bbs.mjtd.com/forum.php?mo ... AC%CF%DF&page=1

ynhh · 发表于 2022-1-30 12:46:55

tigcat 发表于 2022-1-29 22:50
楼主多年前回过这个帖子
这有个速度不算快但能用的帖子
http://bbs.mjtd.com/forum.php?mod=viewthread&t ...

谢谢您这么好的精神
我都记不得了
如没更好的方法
定选您为最佳答案
谢谢

dtucad · 发表于 2022-1-31 17:13:39

本帖最后由 dtucad 于 2022-2-3 22:00 编辑

我发的代码本来就是一次选择生成的楼主自己不测试还在问
本代码已删除自己折腾去吧

ynhh · 发表于 2022-2-1 20:46:56

本帖最后由 ynhh 于 2022-2-1 21:01 编辑

dtucad 发表于 2022-1-31 17:13
楼主的图纸中间部分有非最近点的情况，这个代码只能实现最近点连线

谢谢您
图中的黄色点仅是示意，是指以点集中开口较大（即相邻两点距离最大）的任一端为起点。

这有个也不错，但要手工指定起点

请您看看能不能改成自动判断不用手工指定起点
http://huojibk.com/2020/10/488.html

(defun c:tt (/ lst ss n en pt lst pt1)
(setq ss (ssget '((0 . "point"))) n 0);;请选择点
(repeat (sslength ss);;循环选择
(setq en (ssname ss n);;提取图元
pt (trans(cdr (assoc 10 (entget en))) en 1);;取得点坐标 UCS
lst (cons pt lst);;加入表
n (+ n 1)
)
)
(princ lst)
(setq pt (getpoint "huojibk.com指定开始点"))
(command "spline") ;样条曲线命令
(repeat (length lst);循环计算
(setq lst (vl-sort lst
'(lambda (a b)
(> (distance a pt) (distance b pt));最近点排续
)
)
)
(setq pt1 (last lst));最后一个
(command pt pt1 )
(setq pt (last lst))
(setq lst (cdr(reverse lst)))
)
(command "" "" "")
)

---------------------
《伙计百科》版权所有。
源地址：http://huojibk.com/2020/10/488.html
版权声明：转载请附上博文链接！

xyp1964 · 发表于 2022-2-3 14:15:04

(defun c:tt (); tt(最近点连线)
(if (and (setq ss (ssget '((0 . "point"))))
(setq s1 (car (entsel "\n选择起点: ")))
)
(progn
(setq lst (vl-remove s1 (xyp-Ss2List ss))
lst1 (list s1)
)
(while lst
(setq p0 (xyp-DXF 10 s1)
lst (vl-sort lst
'(lambda (x y)
(< (distance (xyp-DXF 10 x) p0)
(distance (xyp-DXF 10 y) p0)
)
)
)
s1 (car lst)
lst (cdr lst)
lst1 (cons s1 lst1)
)
)
(setq ptn (mapcar '(lambda (x) (xyp-DXF 10 x)) (reverse lst1)))
(xyp-Pline ptn nil)
)
)
(princ)
)

ynhh · 发表于 2022-2-3 16:16:32

xyp1964 发表于 2022-2-3 14:15

谢谢院长指导
您这个和
http://huojibk.com/2020/10/488.html
感觉是一样的啊
请教能不能将其改为自动选择点集中开口较大（即相邻两点距离最大）的任一端为起点
就省了一步手工指定起点了
谢谢您

ynhh · 发表于 2022-2-3 20:39:23

xyp1964 发表于 2022-2-3 19:54

院长威武
能不能大方提供一下这几个函数啊
xyp-Ss2List
xyp-DXF
xyp-Pline
谢谢，无论您是否提供，还是选择您为最佳结果了，感谢您的热心指导。

ynhh · 发表于 2022-2-4 09:19:29

xyp1964 发表于 2022-1-29 22:09

XYP-SS2LIST
院长您公开的函数中就找不到这个啊
如你方便能不能提供一下
谢谢您了

账号		自动登录	找回密码
密码			注册

[函数] 点表按最近点相连排序

最佳答案

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源

点评

点评