;;;求点集包容矩形对角线交点坐标p_j
(defun kcen (plst)
(setq xlst (vl-sort (mapcar '(lambda (x) (car x) ) plst ) '<))
(setq xmin (car xlst))
(setq xmax (last xlst))
(setq ylst (vl-sort (mapcar '(lambda (x) (cadr x) ) plst ) '<))
(setq ymin (car ylst))
(setq ymax (last ylst))
(setq p_j (list (/ (+ xmin xmax) 2.0) (/ (+ ymin ymax) 2.0)))
p_j
)
;;;求点集中各元素到p_j的距离,并根据距离由大到小的规则对点集排序(第一点p_1,就算最远点有多个也不影响程序正确性)
(defun p_dmax (p plst)
(setq lst (vl-sort plst '(lambda(a b) (> (distance p a) (distance p b))) ))
lst
)
;;;求第二点p_2
(defun fmax (p_1 p_j p)
(setq d1 (distance p_1 p_j))
(setq d2 (distance p_1 p))
(setq d3 (distance p_j p))
(setq dn (/ (* d2 d2 d1) (+ (* d1 d1) (* d2 d2) (* d3 d3 -1)) ))
dn
)
(defun pfmax (p_1 p_j plst)
(setq lst (vl-sort plst '(lambda(a b) (> (fmax p_1 p_j a) (fmax p_1 p_j b))) ))
lst
)
;;;求第三点
(defun cc (p_1 p_2 p)
(setq d1 (distance p_1 p))
(setq d2 (distance p_2 p))
(setq d3 (distance p_1 p_2))
(setq cosa (/ (+ (* d1 d1) (* d2 d2) (* d3 d3 -1)) (* d1 d2 2) ))
cosa
)
(defun tmax (p_1 p_2 plst)
(setq lst (vl-sort plst '(lambda(a b) (> (cc p_1 p_2 a) (cc p_1 p_2 b) )) ))
lst
)
;;;取点函数
(defun fp ()
(setq sn (ssget ":N" '((0 . "point"))))
(setq i 0 n (sslength sn) plst nil)
(while (< i n)
(setq plst (cons (cdr (assoc 10 (entget (ssname sn i)))) plst))
(setq i (+ i 1))
)
plst
)
(defun c:fmin()
(setq plst (fp))
(setq p_j (kcen plst))
(setq p_1 (car (p_dmax p_j plst)))
(setq p_2 (car (pfmax p_1 p_j (vl-remove p_1 plst))))
(setq p_3 (car (tmax p_1 p_2 (vl-remove p_2 (vl-remove p_1 plst)))))
(if (< (cc p_1 p_2 p_3) 0)
(progn
(command "circle" "2p" p_1 p_2 "")
(command "line" p_1 p_2 "")
)
(if (> (cc p_1 p_3 p_2) 0)
(progn
(command "circle" "3p" p_1 p_2 p_3 "")
(command "line" p_1 p_2 p_3 p_1 "")
)
(progn
(setq p_2 (car (tmax p_1 p_3 (vl-remove p_1 (vl-remove p_3 plst)))))
(command "circle" "3p" p_1 p_2 p_3 "")
(command "line" p_1 p_2 p_3 p_1 "")
)
)
)
)