矩形转直线

aws

我想把矩形转直线，
我目前是想提取四个顶点坐标，然后比较他们的相邻的距离，找到短边的长度，再取中心点，再进行连线。
感觉有点繁琐了，是不是有更好的思路？

ssyfeng

这应该就是最简单的方法了

aws

(defun c:gg()
        (setq ss(ssget))
        (repeat(setq n(sslength ss))
                (setq en(ssname ss(setq n(1- n))))
                (setq pt(vl-remove-if-not '(lambda(x)(= 10(car x)))(entget en)))
                (setq pt(mapcar '(lambda(x)(cdr x))pt))
                (setq p1(mid(car pt)(cadr pt)))
                (setq p2(mid(caddr pt)(cadr pt)))
                (setq p3(mid(caddr pt)(cadddr pt)))
                (setq p4(mid(car pt)(cadddr pt)))
                (if(>(distance p1 p3)(distance p2 p4))
                        (vl-cmdf "LINE" "non" p1 "non" p3 "")
                        (vl-cmdf "LINE" "non" p2 "non" p4 "")
                )
        )       
       
        (princ)
)
;---两点中心点
(defun mid(p1 p2 / p)
        (setq p(mapcar '(lambda(x y)(*(+ x y)0.5))p1 p2))
)
先贴上我的方法。。欢迎讨论

xyp1964

1. (defun c:tt ()
   
2.   (defun Mid2Pt (p1 p2)(mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2))
   
3.   (defun PlinePtn (e)(mapcar 'cdr   (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget e))))
   
4.   (while (setq s1 (car (entsel "\n选择矩形: ")))
   
5.     (if (= (length (setq ptn (PlinePtn s1))) 4)
   
6.       (progn
   
7.         (mapcar 'set '(p1 p2 p3 p4) ptn)
   
8.         (if (> (distance p1 p2) (distance p2 p3))
   
9.           (command "line" (Mid2Pt p1 p4) (Mid2Pt p2 p3) "")
   
10.           (command "line" (Mid2Pt p1 p2) (Mid2Pt p4 p3) "")
    
11.         )
    
12.       )
    
13.     )
    
14.   )
    
15.   (xyp-End)
    
16. )
    

(defun c:tt ()<br />   (defun Mid2Pt (p1 p2)(mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2))<br />   (defun PlinePtn (e)(mapcar 'cdr   (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget e))))<br />   (while (setq s1 (car (entsel "\n选择矩形: ")))<br />     (if (= (length (setq ptn (PlinePtn s1))) 4)<br />       (progn<br />         (mapcar 'set '(p1 p2 p3 p4) ptn)<br />         (if (> (distance p1 p2) (distance p2 p3))<br />           (command "line" (Mid2Pt p1 p4) (Mid2Pt p2 p3) "")<br />           (command "line" (Mid2Pt p1 p2) (Mid2Pt p4 p3) "")<br />         )<br />       )<br />     )<br />   )<br />   (xyp-End)<br /> )<br />

aws

xyp1964 发表于 2023-12-15 13:11

还有顶点数量判断，更稳妥了

aws

xyp1964 发表于 2023-12-15 13:11

我发现bug了，如果用pl命令去画三角形，assoc搜索出来的是4个顶点，首尾重复一次。画四边形就是5个顶点，但是炸开之后用J命令组合一下，就恢复正常了，所以要想根据顶点来判断几边形，还需要组合一下，才准确。

1506822004

我提供一个思路

四条边共计四个顶点，每相邻两个点产生一个中点，就有四个中点，四个中点两两组合比较，最长的那个就是你要的线

至于顶点判断是几边形的，可以先顶点列表去重一次，然后再用你的方法判断。

aws

1506822004 发表于 2023-12-15 15:16
我提供一个思路

四条边共计四个顶点，每相邻两个点产生一个中点，就有四个中点，四个中点两两组合比较， ...

嗯，此方法，我看行
已解决，谢谢

xyp1964

aws 发表于 2023-12-15 13:49
我发现bug了，如果用pl命令去画三角形，assoc搜索出来的是4个顶点，首尾重复一次。画四边形就是5个顶点， ...

1. (defun c:tt ()
   
2.   "矩形转直线"
   
3.   (defun Mid2Pt (p1 p2)(mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2))
   
4.   (defun PlinePtn (e)(mapcar 'cdr(vl-remove-if '(lambda (x) (/= (car x) 10)) (entget e))))
   
5.   (defun dxf (code e) (cdr (assoc code (entget e))))
   
6.   (setvar "osmode" 0)
   
7.   (while (setq s1 (car (entsel "\n选择矩形: ")))
   
8.     (if(and (= (DXF 90 s1) 4)
   
9.              (= (DXF 70 s1) 1)
   
10.              (setq ptn (PlinePtn s1))
    
11.              (mapcar 'set '(p1 p2 p3 p4) ptn)
    
12.              (equal (distance p1 p3) (distance p2 p4) 1e-3)
    
13.         )
    
14.       (if (> (distance p1 p2) (distance p2 p3))
    
15.         (command "line" (Mid2Pt p1 p4) (Mid2Pt p2 p3) "")
    
16.         (command "line" (Mid2Pt p1 p2) (Mid2Pt p4 p3) "")
    
17.       )
    
18.     )
    
19.   )
    
20.   (xyp-End)
    
21. )
    

(defun c:tt ()<br />   "矩形转直线"<br />   (defun Mid2Pt (p1 p2)(mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2))<br />   (defun PlinePtn (e)(mapcar 'cdr(vl-remove-if '(lambda (x) (/= (car x) 10)) (entget e))))<br />   (defun dxf (code e) (cdr (assoc code (entget e))))<br />   (setvar "osmode" 0)<br />   (while (setq s1 (car (entsel "\n选择矩形: ")))<br />     (if(and (= (DXF 90 s1) 4)<br />              (= (DXF 70 s1) 1)<br />              (setq ptn (PlinePtn s1))<br />              (mapcar 'set '(p1 p2 p3 p4) ptn)<br />              (equal (distance p1 p3) (distance p2 p4) 1e-3)<br />         )<br />       (if (> (distance p1 p2) (distance p2 p3))<br />         (command "line" (Mid2Pt p1 p4) (Mid2Pt p2 p3) "")<br />         (command "line" (Mid2Pt p1 p2) (Mid2Pt p4 p3) "")<br />       )<br />     )<br />   )<br />   (xyp-End)<br /> )<br />