(XD::Pnts:MinRectang)平面点集最小面积矩形

st788796 · 发表于 2014-11-4 11:48:00

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun XD::Pnts:MinRectang (pts / _pnt->2d marea ptl tan v1
p1 p2 p3 ydir rec lst area box
v2
)
(defun _pnt->2d (p) (list (car p) (cadr p)))
(if (<= (length pts) 2)
pts
(progn
(setq pts (xdrx_points_gethull pts) ;_2007+
pts (mapcar '(lambda (x) (_pnt->2d x)) pts)
marea 1e328
ptl pts
tan (/ pi 2)
v1 (mapcar '- (cadr pts) (car pts))
)
(while (and
(> (length ptl) 2)
(< (xdrx_vector_angle
v1
(setq v2 (mapcar '- (cadr ptl) (car ptl)))
)
tan
)
)
(setq ydir (xdrx_vector_product
(xdrx_vector_normalize (xdrx_vector_perpvector v2))
(abs (xdrx_point_dist2line
(caddr ptl)
(car ptl)
(cadr ptl)
)
)
)
rec (xdge::constructor "kBoundBlock2d" (car ptl) v2 ydir)
)
(foreach x pts
(xdge::setpropertyvalue rec "extend" x)
)
(setq lst (xdge::getpropertyvalue rec "get")
area (* (xdrx_vector_length (cadr lst))
(xdrx_vector_length (caddr lst))
)
)
;;(princ "\n")
;;(princ area)
(if (< area marea)
(setq marea area
box lst
)
)
(setq ptl (cdr ptl))
)
(xdge::free)
(list (car box)
(mapcar '+ (car box) (cadr box))
(apply 'mapcar (cons '+ box))
(mapcar '+ (car box) (caddr box))
)
)
)
)

(defun XD::Pnts:MinRectang (pts   /            _pnt->2d        marea ptl   tan          v1 
                        p1    p2    p3          ydir        rec   lst   area  box 
                        v2 
                       ) 
  (defun _pnt->2d (p) (list (car p) (cadr p))) 
  (if (<= (length pts) 2) 
    pts 
    (progn 
      (setq pts          (xdrx_points_gethull pts) ;_2007+ 
            pts          (mapcar '(lambda (x) (_pnt->2d x)) pts) 
            marea 1e328 
            ptl          pts 
            tan          (/ pi 2) 
            v1          (mapcar '- (cadr pts) (car pts)) 
      ) 
      (while (and 
               (> (length ptl) 2) 
               (< (xdrx_vector_angle 
                    v1 
                    (setq v2 (mapcar '- (cadr ptl) (car ptl))) 
                  ) 
                  tan 
               ) 
             ) 
        (setq ydir (xdrx_vector_product 
                     (xdrx_vector_normalize (xdrx_vector_perpvector v2)) 
                     (abs (xdrx_point_dist2line 
                            (caddr ptl) 
                            (car ptl) 
                            (cadr ptl) 
                          ) 
                     ) 
                   ) 
              rec  (xdge::constructor "kBoundBlock2d" (car ptl) v2 ydir) 
        ) 
        (foreach x pts 
          (xdge::setpropertyvalue rec "extend" x) 
        ) 
        (setq lst  (xdge::getpropertyvalue rec "get") 
              area (* (xdrx_vector_length (cadr lst)) 
                      (xdrx_vector_length (caddr lst)) 
                   ) 
        ) 
        ;;(princ "\n") 
        ;;(princ area) 
        (if (< area marea) 
          (setq        marea area 
                box   lst 
          ) 
        ) 
        (setq ptl (cdr ptl)) 
      ) 
      (xdge::free) 
      (list (car box) 
            (mapcar '+ (car box) (cadr box)) 
            (apply 'mapcar (cons '+ box)) 
            (mapcar '+ (car box) (caddr box)) 
      ) 
    ) 
  ) 
)

iLisp · 发表于 2014-11-4 12:50:53

节省点空间可以仅构造一个Bound循环体内用set方法

账号		自动登录	找回密码
密码			立即注册

[点表] (XD::Pnts:MinRectang)平面点集最小面积矩形

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。