aws 发表于 2023-12-15 12:41:11

矩形转直线

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

ssyfeng 发表于 2023-12-15 13:04:03

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

aws 发表于 2023-12-15 13:08:37

(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 发表于 2023-12-15 13:11:11

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

aws 发表于 2023-12-15 13:27:43

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


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

aws 发表于 2023-12-15 13:49:14

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


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

1506822004 发表于 2023-12-15 15:16:02

我提供一个思路

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

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

aws 发表于 2023-12-15 17:34:10

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

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

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

xyp1964 发表于 2023-12-15 18:38:17

aws 发表于 2023-12-15 13:49
我发现bug了，如果用pl命令去画三角形，assoc搜索出来的是4个顶点，首尾重复一次。画四边形就是5个顶点， ...
(defun c:tt ()
"矩形转直线"
(defun Mid2Pt (p1 p2)(mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2))
(defun PlinePtn (e)(mapcar 'cdr(vl-remove-if '(lambda (x) (/= (car x) 10)) (entget e))))
(defun dxf (code e) (cdr (assoc code (entget e))))
(setvar "osmode" 0)
(while (setq s1 (car (entsel "\n选择矩形: ")))
    (if(and (= (DXF 90 s1) 4)
             (= (DXF 70 s1) 1)
             (setq ptn (PlinePtn s1))
             (mapcar 'set '(p1 p2 p3 p4) ptn)
             (equal (distance p1 p3) (distance p2 p4) 1e-3)
      )
      (if (> (distance p1 p2) (distance p2 p3))
      (command "line" (Mid2Pt p1 p4) (Mid2Pt p2 p3) "")
      (command "line" (Mid2Pt p1 p2) (Mid2Pt p4 p3) "")
      )
    )
)
(xyp-End)
)
页: [1]
查看完整版本: 矩形转直线