(defun C:te ();;(/ olderr en errmsg oldmode oce sl ss t0 ptlist pp pp1)
  ;;定義錯誤函數和預處理
  (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 oldmode (getvar "osmode"))
  (setq oce (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command ".ucs" "W")
  ;;也可以用其他方式取得點集
  (setq	sl '((0 . "POINT")))
  (setq t0 (getvar "TDUSRTIMER"))
  (setq ss (ssget sl))
  (setq ptlist (getpt ss))
  ;;分類
  (setq t0 (getvar "TDUSRTIMER"))
  (setq ptlist (sortx ptlist))
  (princ "\n函數排序用時")
  (princ (* (- (getvar "TDUSRTIMER") t0) 86400))
  (princ "秒")
  ;;函數用時估算，以了解函數性能
  (setq t0 (getvar "TDUSRTIMER"))
  (setq pp1 (f2 ptlist) pp (cadr pp1))
  (princ "\n函數查找用時")
  (princ (* (- (getvar "TDUSRTIMER") t0) 86400))
  (princ "秒")
  (if (= nil pp)
    (progn
      (alert "不存在有最小距離的一對點!")
      (command ".ucs" "p")
      (setvar "osmode" oldmode)
      (setvar "cmdecho" oce)
      (princ)
    )
    (progn
      ;;畫最短距離的點對集的連線，可能有多條
      (setvar "osmode" 0)
      (foreach nn pp 
        (entmake
	  (append
	    '((0 . "line")(100 . "AcDbEntity")(100 . "AcDbLine"))
	    (list (cons 10 (car  nn)))
	    (list (cons 11 (cadr nn)))
	    (list (cons 62 1))
	  )
        )
      )
      (command ".ucs" "P")
      (setvar "osmode" oldmode)
      (setvar "cmdecho" oce)
      (princ)
    )
  )
)
;;取點函數，其中i為點的編號
(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 listpp (cons c listpp)) 
      (setq i (1+ i))  
    ) 
  ) 
  (reverse listpp)
)
;;從J到K的表
(defun cut (ptlist j k / i ptlist1)
  (setq i 0 ptlist1 nil)
  (foreach n ptlist
    (if (and (>= i j) (<= i k) )
      (setq ptlist1 (cons n ptlist1))
    )
    (setq i (1+ i))
  )
  (reverse ptlist1)
)
;;對X排序
(defun sortX (ptlist)
  (vl-sort ptlist '(lambda (e1 e2) (< (car e1)(car e2))))
)
;;在帶形區域查找
(defun searchX (ptlist1 x1 x2 / pp)
  ;;(vl-remove-if '(lambda (x)(and (>= (car x) x1)(<= (car x) x2))) ptlist1)
  (setq pp nil)
  (foreach n ptlist1
    (if (and (>= (car n) x1)
	     (<= (car n) x2)
	)
      (setq pp (cons n pp))
    )
  )
  (reverse pp)
)
;;在矩形區域查找
(defun searchXY (ptlist2 x1 x2 y1 y2 / pp)
  (setq pp nil)
  (foreach n ptlist2
    (if (and (>= (car  n) x1)
	     (<= (car  n) x2)
	     (>= (cadr n) y1)
	     (<= (cadr n) y2)
	)
      (setq pp (cons n pp))
    )
  )
  (reverse pp)
)
;;最多6點最小距離
(defun 6ptmin (ptlist4 pt / 6pmin 6plist)
  (setq 6pmin (mapcar '(lambda (x) (distance x pt)) ptlist4))
  (setq 6pmin (apply 'min 6pmin) 6plist nil) 
  (foreach 6name ptlist4
    (if (equal (distance 6name pt) 6pmin 1e-6)
      (setq 6plist (cons (list pt 6name) 6plist)) 
    )  
  )
  (list (+ 6pmin 1e-6) 6plist) 		      
)
;;***************
;;程序主段-------
(defun f2 (ptlist / l p1 p2 p3 dd 3pmind 3plist ptlist1 ptlist2 ptlist3 ptlist4  
	         n m midpt mind1 mind2 mindt a b c d Dismin Dnmin nplist mindi)
  (setq l (length ptlist))	
  (cond
    ( (= l 2);;兩點還用說    
      (list (+ (distance (car ptlist) (cadr ptlist)) 1e-6)
	    (list ptlist)
      )
    )
    ( (= l 3);;三點最小距離直接求解點對
      (progn
	(setq p1 (car ptlist) p2 (cadr ptlist) p3 (caddr ptlist))
	(setq dd
          (list (list (distance p1 p2) (list p1 p2))
		(list (distance p1 p3) (list p1 p3))
		(list (distance p2 p3) (list p2 p3))
	  )
	)
	(setq 3pmind (apply 'min (mapcar 'car dd)))
	(setq 3plist nil)
	(foreach 3name dd
	  (if (equal (car 3name) 3pmind 1e-6)
	    (setq 3plist (cons (cadr 3name) 3plist))
	  )
	)
        (list (+ 3pmind 1e-6) 3plist)
      )
    )
    ( (> l 2)
      (progn
	(setq n (/ l 2) m (- l n));;分治
	(setq ptlist1 (cut ptlist 0 (1- m)))
	(setq ptlist2 (cut ptlist m l))
	(setq midpt (last ptlist1))
	(setq mind1 (f2 ptlist1));;遞歸左邊
	(setq mind2 (f2 ptlist2));;遞歸右邊
	(setq mindT
	  (cond
	    ((equal (car mind1) (car mind2) 1e-6)(list (car mind1) (append (cadr mind1) (cadr mind2))))
	    ((< (car mind1) (car mind2)) mind1)
	    (t mind2)
	  )
	)
	(setq mindi (car mindT))
	(setq a (- (car midpt) mindi) b (car midpt))
	(setq ptlist3 (searchX ptlist1 a b))
	(if (/= ptlist3 nil)
	  (progn 
	    (setq Dismin nil)
            (foreach name ptlist3
	      (setq a (car midpt) b (+ (car midpt) mindi) c (- (cadr name) mindi) d (+ (cadr name) mindi))
	      (setq ptlist4 (searchXY ptlist2 a b c d))
	      (if (/= ptlist4 nil)
                (setq Dismin (cons (6ptmin ptlist4 name) Dismin))
	      )
	    )
	    (if (= Dismin nil)
	      mindT
	      (progn
	        (setq Dnmin (apply 'min (mapcar 'car Dismin)) nplist nil)
		(foreach npname Dismin
		  (if (equal (car npname) Dnmin 1e-6)
		    (setq nplist (append (cadr npname) nplist))
		  )
		)
	        (cond
		  ((equal (car mindT) Dnmin 1e-6) (list mindi (append nplist (cadr mindT))))
		  ((< (car mindT) Dnmin) mindT)  
	          (t (list Dnmin nplist))
	        );;for inest cond
	      );;for inest if-progn
	    );;for inest if
	  )mindT;;for if-progn
	);;for if
      );;for cond-last-progn
    );;for cond-last
  );;for cond
);;for defun
;;***************