(defun C:test (/ olderr en errmsg oce sl ss t0 pp
                 ptlist ptlst1 ptlst2 ppup ppdw)
  ;;定義錯誤函數和預處理
  (setvar "errno" 0)
  (setq olderr *error*)
  (defun *error* (msg)
    (setq en (getvar "errno"))
    (setq errmsg (strcat "errno=" (itoa en) "\nError:" msg))
    (alert errmsg)
    (setq *error* olderr)
  )
  (graphscr)
  (setq oce (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command ".ucs" "W")
  ;;也可以用其他方式取得點集
  (setq sl '((0 . "POINT")))
  (setq ss (ssget sl))
  (if (= nil ss)
    (progn
      (alert "你輸入的點數目太小!")
      (command ".ucs" "p")
      (setvar "cmdecho" oce)
      (princ)
    )
    (progn
      (setq ptlist (getpt ss))
      ;;計算凸包用時
      (setq t0 (getvar "TDUSRTIMER"))
      ;;排序
      (setq ptlist (XYsort ptlist))
      ;;分包
      (setq ptlist (divide ptlist))
      (setq ptlst1 (car ptlist) ptlst2 (cadr ptlist))
      ;;分別求出上凸包和下凸包
      (setq ppup (cdr (hull1 ptlst1)))
      (setq ppdw (cdr (hull1 ptlst2)))
      ;;合并凸包
      (setq pp (append ppup ppdw))
      (princ "\n構造凸包用時")
      (princ (* (- (getvar "TDUSRTIMER") t0) 86400))
      (princ "秒")
      ;;畫凸包
      (entmake
	(append
	  '((0 . "lwpolyline")(100 . "AcDbEntity")(100 . "AcDbPolyline"))
	  (list (cons 90 (length pp)))
	  (mapcar '(lambda (x) (cons 10 (list (car x) (cadr x)))) pp)
	  (list (cons 70 1))
	  (list (cons 62 1))
	)
      )
      (command ".ucs" "P")
      (setvar "cmdecho" oce)
      (gc)
      (princ)
    )
  )
)
;;取點函數
(defun getpt (ss / i listpp a b c) 
  (setq i 0 listpp nil ) 
  (if ss 
    (repeat (sslength ss) 
      (setq a (ssname ss i)) 
      (setq b (entget a)) 
      (setq c (cdr (assoc 10 b)))
      (setq c (list (car c) (cadr c)))
      (setq listpp (cons c listpp)) 
      (setq i (1+ i))  
    ) 
  ) 
  (reverse listpp)
)
;;定義矢量之叉積,即二階行列式之值
(defun det2 (p1 p2)
  (- (* (car p1) (cadr p2)) (* (car p2) (cadr p1)))
)
;;定義三點的行列式,即三點之倍面積
(defun det (p1 p2 p3)
  (+ (det2 p1 p2) (det2 p2 p3) (det2 p3 p1))
)	
;;定義判別法則
(defun judge (p1 p2 p3 / x)
  (setq x (det p1 p2 p3))
  (if (> x 0) t nil)
)
;;定義排序函數
(defun XYsort (ptlist)
  (vl-sort ptlist
	   '(lambda (e1 e2)
	      (if (equal (car e1) (car e2) 1e-8)
		(< (cadr e1) (cadr e2))
		(< (car  e1) (car  e2))
	      )
	    )
  )
)
;;;************************************
;;;程序的主段--------------------------
;;;求凸包函數--------------------------
(defun Hull1 (ptlist / l p1 p2 p3 ppp pp1 pp2) 
  (setq l (length ptlist))
  (if (<= l 3)
    ptlist
    (progn 
      (setq p1 (car  ptlist));;左端點
      (setq p2 (last ptlist));;右端點
      (setq ppp (mapcar '(lambda (x) (det x p1 p2)) ptlist))
      (setq p3 (nth (vl-position (apply 'max ppp) ppp) ptlist));;最大面積點
      (foreach n ptlist
        (if (and (judge p1 p3 n) (judge p3 n p2))
	  (setq pp1 (cons n pp1))
        )
        (if (and (judge p1 n p3) (judge n p3 p2))
	  (setq pp2 (cons n pp2))
        )
      )
      (setq pp1 (reverse pp1) pp1 (cons p1 pp1) pp1 (append pp1 (list p3)))
      (setq pp2 (reverse pp2) pp2 (cons p3 pp2) pp2 (append pp2 (list p2)))
      (setq pp1 (hull1 pp1) pp2 (hull1 pp2));;遞歸(recursion)
      (append pp1 (vl-remove p3 pp2))
    )
  )
)
;;;分包函數----------------------------
(defun divide (ptlist / p1 p2 ptlist1 ptlist2)
  (setq p1 (car ptlist))
  (setq p2 (last ptlist))
  (setq	ptlist1
    (vl-remove-if
      (function (lambda (x)(< (- (angle p2 p1) (angle p2 x)) 0))) ptlist
    )
  )
  (setq	ptlist2
    (vl-remove-if
      (function (lambda (x)(> (- (angle p2 p1) (angle p2 x)) 0))) ptlist
    )
  )
  (setq ptlist1 (append (cons p1 ptlist1) (list p2)))
  (setq ptlist2 (append (cons p1 ptlist2) (list p2)))
  (list ptlist1 (reverse ptlist2))
)
;;;主段結束****************************
;;;************************************