【函数】curve:rectanglep 测试一个多段线是否为矩形

vitalgg

【函数】curve:rectanglep 测试一个多段线是否为矩形


本函数源码：
https://gitee.com/atlisp/atlisp- ... urve/rectanglep.lsp

@lisp函数库
https://gitee.com/atlisp/atlisp-lib


函数库问题讨论，建议及意见交流区
https://gitee.com/atlisp/atlisp-lib/issues

@lisp开源项目
https://gitee.com/atlisp

1. (defun curve:rectanglep (ent)
   
2.   "测试一个多段线是否为矩形"
   
3.   "T or nil"
   
4.   (and
   
5.    (= 'ename (type ent))
   
6.    (wcmatch (entity:getdxf ent 0) "*POLYLINE") ;; 是多段线
   
7.    (or ;; 4点且闭合 或 5点首尾点相同
   
8.     (and (= (entity:getdxf ent 90) 4)
   
9.    (= (entity:getdxf ent 70) 1))
   
10.     (and (= (entity:getdxf ent 90) 5)
    
11.    (= (entity:getdxf ent 70) 0)))
    
12.    (apply '= (entity:getdxf ent 42))
    
13.    (progn
    
14.      (setq pts (curve:get-points ent))
    
15.      (setq ang
    
16.      (abs
    
17.       (- (angle (nth 0 pts)(nth 1 pts))
    
18.          (angle (nth 1 pts)(nth 2 pts)))))
    
19.      (if (> ang pi)(setq ang (- ang pi)))
    
20.      ;; 邻边垂直且对角长度相等
    
21.      (and
    
22.       (equal ang (* pi 0.5) 1e-6)
    
23. 
    
24.       (equal (distance (nth 0 pts)(nth 1 pts))
    
25.              (distance (nth 2 pts)(nth 3 pts))
    
26.              1e-6)
    
27.       (equal (distance (nth 0 pts)(nth 2 pts))
    
28.        (distance (nth 1 pts)(nth 3 pts))
    
29.     1e-6)
    
30.       (if (nth 4 pts) ;; 存在第5点时，第5点同第1点
    
31.     (< (distance (nth 0 pts)(nth 4 pts)) 1e-6)
    
32.   t)
    
33.       ))))

(defun curve:rectanglep (ent)<br />   "测试一个多段线是否为矩形"<br />   "T or nil"<br />   (and<br />    (= 'ename (type ent))<br />    (wcmatch (entity:getdxf ent 0) "*POLYLINE") ;; 是多段线<br />    (or ;; 4点且闭合 或 5点首尾点相同<br />     (and (= (entity:getdxf ent 90) 4)<br />    (= (entity:getdxf ent 70) 1))<br />     (and (= (entity:getdxf ent 90) 5)<br />    (= (entity:getdxf ent 70) 0)))<br />    (apply '= (entity:getdxf ent 42))<br />    (progn<br />      (setq pts (curve:get-points ent))<br />      (setq ang<br />      (abs<br />       (- (angle (nth 0 pts)(nth 1 pts))<br />          (angle (nth 1 pts)(nth 2 pts)))))<br />      (if (> ang pi)(setq ang (- ang pi)))<br />      ;; 邻边垂直且对角长度相等<br />      (and<br />       (equal ang (* pi 0.5) 1e-6)<br /> <br />       (equal (distance (nth 0 pts)(nth 1 pts))<br />              (distance (nth 2 pts)(nth 3 pts))<br />              1e-6)<br />       (equal (distance (nth 0 pts)(nth 2 pts))<br />        (distance (nth 1 pts)(nth 3 pts))<br />     1e-6)<br />       (if (nth 4 pts) ;; 存在第5点时，第5点同第1点<br />     (< (distance (nth 0 pts)(nth 4 pts)) 1e-6)<br />   t)<br />       ))))

公众号：CAD应用云 中寻求帮助



CAD命令行中寻求帮助



CAD命令行中聊天寻求帮助






VScode 中寻求帮助

77077

我有强迫症，我认为顶点数不为4的不能算矩形，不闭合的不能算矩形，带凸度的不能算矩形。

不知道对不对？

2. (and
   
3.         (setq curve(car(entsel "\n选择对象:")))
   
4.         (= (vlax-curve-getEndParam curve) 4)
   
5.         (vlax-curve-isClosed curve)
   
6.         (setq d1 (vlax-curve-getDistAtParam curve 1))
   
7.         (setq d2 (- (vlax-curve-getDistAtParam curve 2) d1))
   
8.         (equal (vlax-curve-getArea curve) (* d1 d2) 1e-6)
   
9. )

(and<br />         (setq curve(car(entsel "\n选择对象:")))<br />         (= (vlax-curve-getEndParam curve) 4)<br />         (vlax-curve-isClosed curve)<br />         (setq d1 (vlax-curve-getDistAtParam curve 1))<br />         (setq d2 (- (vlax-curve-getDistAtParam curve 2) d1))<br />         (equal (vlax-curve-getArea curve) (* d1 d2) 1e-6)<br /> )

vitalgg

77077 发表于 2023-1-12 09:53
我有强迫症，我认为顶点数不为4的不能算矩形，不闭合的不能算矩形，带凸度的不能算矩形。

不知道对不 ...

你说的对。

kozmosovia

万一超过一个点有重合呢？

vitalgg

kozmosovia 发表于 2023-1-12 22:34
万一超过一个点有重合呢？

先用 killover 处理一下

哆啦A梦_oELxg

"contributes.grammars.language" 中包含未知语言。提供的值: autolisp-injection
命令“autolisp.loadActiveFile”在 `commands` 部分重复出现。

看看用@lisp函数库经常用不了，出现这个是怎么回事。

vitalgg

哆啦A梦_oELxg 发表于 2023-2-10 23:15
"contributes.grammars.language" 中包含未知语言。提供的值: autolisp-injection
命令“autolisp.loadAct ...

应该是需要安装 markdown 相关扩展才行。
我把这段删了吧。请更新扩展版本到 1.4.18 试一下。

{
                                "language": "autolisp-injection",
                                "scopeName": "markdown.autolisp.codeblock",
                                "path": "./syntaxes/cl_codeblock.tmLanguage.json",
                                "injectTo": [
                                        "text.html.markdown"
                                ],
                                "embeddedLanguages": {
                                        "meta.embedded.block.autolisp": "autolisp"
                                }
                        }

哆啦A梦_oELxg

vitalgg 发表于 2023-2-11 09:20
应该是需要安装 markdown 相关扩展才行。
我把这段删了吧。请更新扩展版本到 1.4.18 试一下。

给力，安装markdown all in one扩展后，没问题了。