封闭四边顶点连线

117g

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

我主要是为了解决当下遇到的问题去想的这个功能，而且我目前能力不够技术很菜，autolisp的书也才看了一小部分，很难把思路转化为代码语言。所以没有大佬考虑的那么多，适用性小了点。
功能方面 算是上下2条拟合线取出来顶点，然后4个顶点连线。只不过两条拟合线首尾已经用直线连接起来形成了一个闭合的多段线框，方便批量处理

117g

已成封闭图形，并且打算批量处理，用上下两条线的端点没办法批量操作，还是只能2根线去单选

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

vitalgg 发表于 2023-11-23 11:31
求所有点。然后只有四个角度近似 90度，其它近似0度。
代码容差为 0.05pi，根据需要自行调整。

感谢大佬的代码，看动图是我想要实现的功能  
但我加载的时候还是会报错，提示输入列表有缺陷

117g

vitalgg 发表于 2023-11-23 11:31
求所有点。然后只有四个角度近似 90度，其它近似0度。
代码容差为 0.05pi，根据需要自行调整。

想问下大佬  这个报错该怎么处理？

vitalgg

117g 发表于 2023-11-23 19:53
想问下大佬  这个报错该怎么处理？

最后if 条件少打一个右括号。已更正。

菜鸟初来乍到

vitalgg 发表于 2023-11-23 11:31
求所有点。然后只有四个角度近似 90度，其它近似0度。
代码容差为 0.05pi，根据需要自行调整。

太强了，感谢大佬分享

树櫴希德

请问大佬主要做什么用啊

117g

树櫴希德 发表于 2023-11-24 11:24
请问大佬主要做什么用啊

函数封闭曲线，放到cad中处理，cad的函数线不会画，只能用多段线控制精度拟合再操作了