已知多边形求四角点

kry

如图，已知左图求右图中四点~!图中虽然是矩形，但尽量可求平形四边形，而且不能用偏移求此点表

淮上

严重鄙视楼上的行为，愿意帮忙就把代码贴出来，不帮忙就走开，耍什么噱头，真不知道你的水平到底有多高？？！！

;;方法通常有三种
;;1.纯AutoLISP方法
;;2.vlax方法
;;3.vla方法
;;下面以第三种为例
;; (HS_get_Vertex (car (entsel)))
(defun HS_get_Vertex (pl_ename / plst lst)
  (setq pl_ename (vlax-ename->vla-object pl_ename)
        plst     (vlax-get pl_ename 'coordinates)
  )
  (repeat (/ (length plst) 2)
    (setq lst  (append lst (list (list (car plst) (cadr plst))))
          plst (cddr plst)
    )
  )
  lst
)

kry

先谢谢楼上的兄弟，但上面的程序不是我想要的，我要求的是4个红色点的点表，而这4个的是由矩形向内偏一个距离,而不是矩形的四个角点

NetBee

先使用3楼的程序提取原矩形的角点坐标，再使用最简单的几何变换就行了。这种几何计算方法在网上一搜一大片

kry

逛晕，说了等于没说.....

NetBee

要别人全新写码给你吗？

淮上

(defun GetVertexs (e / i v lst)
  (setq i -1)
  (while (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
    (setq lst (cons v lst))
  )
  (if (vlax-curve-isClosed e) (setq lst (cdr lst)))
  (reverse lst)
)
;;只对平行四边形有效,因为其他直段的多段线需要提供一个向量
(defun PointsOffset (lst di)
  (mapcar '(lambda (x y z / a1 a2 a p)
             (setq a1 (angle y x)
                   a2 (angle y z)
                   a  (abs (- a1 a2))
             )
             (if (>= a pi)
               (setq a (/ (- (* pi 2) a) 2))
               (setq a (/ a 2))
             )
             (setq p (mapcar '(lambda (x y) (/ (+ x y) 2))
                               (polar y a1 1)
                               (polar y a2 1)
             ))
             (polar y (angle y p) (/ di (sin a)))
           )
          (append (cdr lst) (list (car lst)))
          lst
          (append (list (last lst)) (reverse (cdr (reverse lst))))
  )
)

;;测试
(defun c:tt (/ e d ps os)
  (if (and (setq e (entsel))
           (setq d (getdist "\n指定偏移距离: ")))
    (progn
      (setq os (getvar "osmode")
            ps (GetVertexs (car e))
            ps (PointsOffset PS d)
      )
      (setvar "osmode" 0)
      (apply 'command (cons "_.pline" ps))
      (command "_close")
      (setvar "osmode" os)
    )
  )
  (princ)
)

894560869

http://bbs.mjtd.com/forum.php?mo ... amp;_dsign=c71b7f8f