封闭四边顶点连线

117g

功能：框选多个闭合的近似四边形，用多段线批量作出各图形4个顶点的连线。
最近帖子比较乱，整理下帖子，感谢大佬提供的源码

vitalgg

求所有点。然后只有四个角度近似 90度，其它近似0度。
代码容差为 0.05pi，根据需要自行调整。

1. (defun c:rec4 ()
   
2.   (progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))
   
3.   (setq lwpls (pickset:to-list (ssget  '((0 . "lwpolyline")))))
   
4.   (foreach
   
5.    lwpl lwpls
   
6.    ;; 分析各点角度
   
7.    (setq pts (curve:get-points lwpl))
   
8.    (print pts)
   
9.    (setq pt-first (car pts))
   
10.    (setq pt-end (last pts))
    
11.    (setq pts (append (list pt-end) pts (list pt-first)))
    
12.    (setq angles '())
    
13.    (setq ang 0)
    
14.    (setq pts-rec nil)
    
15.    (while (and (> (length  pts) 2)
    
16.          (or (< ang (* 0.05 pi))
    
17.        (> ang (* 1.95 pi))
    
18.        (equal ang (* 0.5 pi) (* 0.05 pi))
    
19.        (equal ang (* 1.5 pi) (* 0.05 pi)))
    
20.          )
    
21.      
    
22.      (setq ang (-(angle  (cadr pts)(caddr pts))
    
23.      (angle (car pts)(cadr pts))))
    
24.      (print ang)
    
25.      (setq ang (abs ang))
    
26.      (if (or (equal ang (* 0.5 pi) (* 0.05 pi))
    
27.               (equal ang (* 1.5 pi) (* 0.05 pi)))
    
28.          (setq pts-rec (cons (cadr pts) pts-rec)))
    
29.      (setq pts (cdr pts)))
    
30.    (if (and (= (length pts) 2)  (= 4 (length pts-rec)))
    
31.        (entity:make-lwpolyline pts-rec nil 0 1 0)))
    
32. )

(defun c:rec4 ()<br />   (progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))<br />   (setq lwpls (pickset:to-list (ssget  '((0 . "lwpolyline")))))<br />   (foreach<br />    lwpl lwpls<br />    ;; 分析各点角度<br />    (setq pts (curve:get-points lwpl))<br />    (print pts)<br />    (setq pt-first (car pts))<br />    (setq pt-end (last pts))<br />    (setq pts (append (list pt-end) pts (list pt-first)))<br />    (setq angles '())<br />    (setq ang 0)<br />    (setq pts-rec nil)<br />    (while (and (> (length  pts) 2)<br />          (or (< ang (* 0.05 pi))<br />        (> ang (* 1.95 pi))<br />        (equal ang (* 0.5 pi) (* 0.05 pi))<br />        (equal ang (* 1.5 pi) (* 0.05 pi)))<br />          )<br />      <br />      (setq ang (-(angle  (cadr pts)(caddr pts))<br />      (angle (car pts)(cadr pts))))<br />      (print ang)<br />      (setq ang (abs ang))<br />      (if (or (equal ang (* 0.5 pi) (* 0.05 pi))<br />               (equal ang (* 1.5 pi) (* 0.05 pi)))<br />          (setq pts-rec (cons (cadr pts) pts-rec)))<br />      (setq pts (cdr pts)))<br />    (if (and (= (length pts) 2)  (= 4 (length pts-rec)))<br />        (entity:make-lwpolyline pts-rec nil 0 1 0)))<br /> )

如果无法播放，请点击此处在新窗口打开

117g

liuhe 发表于 2023-11-22 13:12
你的规律性不够明显，如图所示，这个五角星的四个顶点是什么？
通常大家求解的是包围盒

我理解的大致意思 大佬是想根据多段线上的某线计算到下一条相邻线的夹角，依次循环，在角度突变的位置取出顶点，采用这种方式赋值取顶点，确实需要明确的角度取值范围去排除多余节点

       至于大佬讲的五角星形状，我没有考虑去做那种特殊多边形的，要实现的功能和最小外包框的功能不一样，应该是五角星的5个顶点的依次（顺/逆时针都可）的连线。这点我的贴子里确实没有说清楚，非常抱歉

我想应用的范围是  对边是函数拟合线而且外框近似四边形的封闭多段线，所以用xy求和求差的最大最小值是能满足赋值取到这四个点的要求

liuhe

你的规律性不够明显，如图所示，这个五角星的四个顶点是什么？
通常大家求解的是包围盒

所谓的近似矩形，只是把多线段的上点 P1 P2 P3  ,如果P1 P2 组成的直线角度和P2 P3组成直线角度  在误差范围内，比如 P1 P2 是 0度角， P2 P3是1度角，那么就把 P2去掉。 以此类推，最后剩余四个顶点。  这个误差是关键

wangsr

做的不错谢谢。

liuhe

117g 发表于 2023-11-22 14:34
我理解的大致意思 大佬是想根据多段线上的某线计算到下一条相邻线的夹角，依次循环，在角度突变的位置取 ...

拟合线的线 只有四个顶点，只对这四个顶点排序？

kozmosovia

想复杂了，直接从所有点里取最远的两个点，就是四边形对角点，然后两点连线分别求两侧距离连线最远点。

lxx2003

这个看起来有点复杂

117g

liuhe 发表于 2023-11-22 16:55
拟合线的线 只有四个顶点，只对这四个顶点排序？

算是把两条拟合线的两侧端点取出来连线吧

117g

wangsr 发表于 2023-11-22 16:51
做的不错谢谢。

有个大致的思路，但楼主编程能力为0，半个月参照明经其他大佬的源码才搞出来一部分，还剩一部分没有搞出来

ghgh0130