四边形按方位获取坐标

tanle2020

论坛有人发过此贴，可惜看不到回复内容，请问如何按方位获取四边形的坐标

kucha007

如果四边形在2维平面的话，可以试一下这样：

1. (progn
   
2.     (setq en (car (nentsel)));获取四边形
   
3.     (setq Lst (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget en))));获取顶点X和Y
   
4.     (setq Lst
   
5.         (vl-sort Lst
   
6.             '(lambda (a b)
   
7.               (minusp
   
8.                 (-
   
9.                   (* (car a) (cadr b))
   
10.                   (* (car b) (cadr a))
    
11.                 )
    
12.               )
    
13.               
    
14.             )
    
15.         )
    
16.     );计算两点叉积,按顺时针排序
    
17.     (setq Lst (mapcar '(lambda (x)(nth x Lst))(list 1 2 0 3)));按顺序重新调整表   
    
18. )
    

(progn<br />     (setq en (car (nentsel)));获取四边形<br />     (setq Lst (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget en))));获取顶点X和Y<br />     (setq Lst<br />         (vl-sort Lst<br />             '(lambda (a b)<br />               (minusp<br />                 (-<br />                   (* (car a) (cadr b))<br />                   (* (car b) (cadr a))<br />                 )<br />               )<br />               <br />             )<br />         )<br />     );计算两点叉积,按顺时针排序<br />     (setq Lst (mapcar '(lambda (x)(nth x Lst))(list 1 2 0 3)));按顺序重新调整表   <br /> )<br />

vitalgg

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

原来下面也是从左到右啊，已更正

1. (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))))
   
2. 
   
3. (defun c:jd ()
   
4.   (setq ss (ssget  '((0 . "LWPOLYLINE"))))
   
5.   (foreach
   
6.    lwpl (pickset:to-list ss)
   
7.    (setq pts (curve:get-points lwpl))
   
8.    (progn
   
9.      (setq pt-center (point:centroid pts))
   
10.      (setq pts (vl-sort
    
11.     pts
    
12.     ;; 都在x轴上按顺时针，都在x轴下按逆时针。x轴上在排前面。
    
13.     '(lambda(x y)
    
14.       (cond
    
15.         ((and (< (m:fix-angle (+ pi (angle pt-center x))) pi)
    
16.         (< (m:fix-angle (+ pi (angle pt-center y))) pi))
    
17.          (< (m:fix-angle (+ pi (angle pt-center x)))
    
18.       (m:fix-angle (+ pi (angle pt-center y)))))
    
19.         (t
    
20.           (> (m:fix-angle (+ pi (angle pt-center x)))
    
21.       (m:fix-angle (+ pi (angle pt-center y)))))
    
22.         ))))
    
23.      ;;
    
24.      (setq n 0)
    
25.      (mapcar '(lambda(x)
    
26.          (entity:make-text
    
27.     (strcat  "PT"(itoa (setq n (1+ n))))
    
28.     x
    
29.     3 0 0.8 0 "LB"))
    
30.        pts))))

(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 /> <br /> (defun c:jd ()<br />   (setq ss (ssget  '((0 . "LWPOLYLINE"))))<br />   (foreach<br />    lwpl (pickset:to-list ss)<br />    (setq pts (curve:get-points lwpl))<br />    (progn<br />      (setq pt-center (point:centroid pts))<br />      (setq pts (vl-sort<br />     pts<br />     ;; 都在x轴上按顺时针，都在x轴下按逆时针。x轴上在排前面。<br />     '(lambda(x y)<br />       (cond<br />         ((and (< (m:fix-angle (+ pi (angle pt-center x))) pi)<br />         (< (m:fix-angle (+ pi (angle pt-center y))) pi))<br />          (< (m:fix-angle (+ pi (angle pt-center x)))<br />       (m:fix-angle (+ pi (angle pt-center y)))))<br />         (t<br />           (> (m:fix-angle (+ pi (angle pt-center x)))<br />       (m:fix-angle (+ pi (angle pt-center y)))))<br />         ))))<br />      ;; <br />      (setq n 0)<br />      (mapcar '(lambda(x)<br />          (entity:make-text<br />     (strcat  "PT"(itoa (setq n (1+ n))))<br />     x<br />     3 0 0.8 0 "LB"))<br />        pts))))

xyp1964

tanle2020 发表于 2024-2-2 12:48
我用这个排序方法实现了，先把四个点表按x排序，然后把最x最小的两个点按y排序得出左上和左下，剩余x最大 ...

1. (defun abc (pl / ptn ptn1 ptn2 p1 p2 p3 p4)
   
2.   (setq ptn (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget pl)))
   
3.         ptn (vl-sort ptn '(lambda (x y) (> (cadr x) (cadr y))))
   
4.   )
   
5.   (mapcar 'set '(p1 p2 p3 p4) ptn)
   
6.   (setq ptn1 (vl-sort (list p1 p2) '(lambda (x y) (< (car x) (car y))))
   
7.         ptn2 (vl-sort (list p3 p4) '(lambda (x y) (< (car x) (car y))))
   
8.   )
   
9.   (append ptn1 ptn2)
   
10. )
    

(defun abc (pl / ptn ptn1 ptn2 p1 p2 p3 p4)<br />   (setq ptn (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget pl)))<br />         ptn (vl-sort ptn '(lambda (x y) (> (cadr x) (cadr y))))<br />   )<br />   (mapcar 'set '(p1 p2 p3 p4) ptn)<br />   (setq ptn1 (vl-sort (list p1 p2) '(lambda (x y) (< (car x) (car y))))<br />         ptn2 (vl-sort (list p3 p4) '(lambda (x y) (< (car x) (car y))))<br />   )<br />   (append ptn1 ptn2)<br /> )<br />

1. (defun abc2 (pl / ptn pptn1 ptn2 p1 p2 p3 p4)
   
2.   (setq ptn (mapcar 'cdr(vl-remove-if '(lambda (x) (/= (car x) 10)) (entget pl)))
   
3.         ptn (vl-sort ptn '(lambda (x y) (< (car x) (car y))))
   
4.   )
   
5.   (mapcar 'set '(p1 p2 p3 p4) ptn)
   
6.   (setq ptn1 (vl-sort (list p1 p2) '(lambda (x y) (> (cadr x) (cadr y))))
   
7.         ptn2 (vl-sort (list p3 p4) '(lambda (x y) (> (cadr x) (cadr y))))
   
8.   )
   
9.   (list (car ptn1) (car ptn2) (cadr ptn1) (cadr ptn2))
   
10. )
    

(defun abc2 (pl / ptn pptn1 ptn2 p1 p2 p3 p4)<br />   (setq ptn (mapcar 'cdr(vl-remove-if '(lambda (x) (/= (car x) 10)) (entget pl)))<br />         ptn (vl-sort ptn '(lambda (x y) (< (car x) (car y))))<br />   )<br />   (mapcar 'set '(p1 p2 p3 p4) ptn)<br />   (setq ptn1 (vl-sort (list p1 p2) '(lambda (x y) (> (cadr x) (cadr y))))<br />         ptn2 (vl-sort (list p3 p4) '(lambda (x y) (> (cadr x) (cadr y))))<br />   )<br />   (list (car ptn1) (car ptn2) (cadr ptn1) (cadr ptn2))<br /> )<br />

飞雪神光

只有这四个点可以用黄明儒的排序 需要排四次 还有复杂点的按象限获取

tigcat

谢谢兄台分享实用源码,论坛有你更精彩!

guosheyang

方法一 保证节点方向为顺时针   然后 x从小到大排 x相同时 y从大到小排  确定第一点pt1 多段线节点表中 依次提取pt2  pt3  pt4   最后将pt4  pt3 换下顺序
方法二  x从小到大排 x相同时 y从大到小排  确定第一点pt1
            x从大到小排 x相同时 y从大到小排  确定第二点pt2
            x从小到大排 x相同时 y从小到大排  确定第三点pt3
            x从大到小排 x相同时 y从小到大排  确定第四点pt4
           （其实方法二中  只需要计算 两次  不用四次就可得到结果
            在两组点x值相同时  计算一次即可

）
           

xyp1964

1. (defun c:tt ()
   
2.   "四边形按方位获取坐标"
   
3.   (xyp-Start)
   
4.   (setq i -1)
   
5.   (if (setq ss (ssget '((0 . "*po*") (90 . 4) (70 . 1))))
   
6.     (while (setq s1 (ssname ss (setq i (1+ i))))
   
7.       (setq ptn (xyp-Vertexs s1 0);顶点
   
8.             ptn (xyp-Ptn2CCW ptn);逆时针排序
   
9.             p7 (xyp-9pt s1 7);左上角点基点
   
10.             p7 (xyp-PtNearPtn p7 ptn);左上角点
    
11.             ptn (xyp-SortListSub ptn p7);重新排序
    
12.             lst (list (car ptn) (last ptn) (cadr ptn) (caddr ptn));左上 右上 左下 右下
    
13.             j0
    
14.       )
    
15.       (mapcar '(lambda (x)(setq j  (1+ j)tx (strcat "pt" (itoa j)))(xyp-Text 5 x tx))lst)
    
16.     )
    
17.   )
    
18.   (xyp-End)
    
19. )

(defun c:tt ()<br />   "四边形按方位获取坐标"<br />   (xyp-Start)<br />   (setq i -1)<br />   (if (setq ss (ssget '((0 . "*po*") (90 . 4) (70 . 1))))<br />     (while (setq s1 (ssname ss (setq i (1+ i))))<br />       (setq ptn (xyp-Vertexs s1 0);顶点<br />             ptn (xyp-Ptn2CCW ptn);逆时针排序<br />             p7 (xyp-9pt s1 7);左上角点基点<br />             p7 (xyp-PtNearPtn p7 ptn);左上角点<br />             ptn (xyp-SortListSub ptn p7);重新排序<br />             lst (list (car ptn) (last ptn) (cadr ptn) (caddr ptn));左上 右上 左下 右下<br />             j0<br />       )<br />       (mapcar '(lambda (x)(setq j  (1+ j)tx (strcat "pt" (itoa j)))(xyp-Text 5 x tx))lst)<br />     )<br />   )<br />   (xyp-End)<br /> )

tanle2020

kucha007 发表于 2024-1-31 20:43
如果四边形在2维平面的话，可以试一下这样：

感谢解答，测试了一下在不同形状的四边形还是不行，只是按顺序排序了

tanle2020

vitalgg 发表于 2024-1-31 20:20

这是加载了网络自定义函数吧

tanle2020

xyp1964 发表于 2024-1-31 23:54

院长无所不能，给个排序的代码学习一下了