;;; 命令: JL
;;; 功能：框选线段→连接最近端点→自动删除最长连线→合并为一条多段线
;;; 兼容：AutoCAD 2008

(defun C:JL (/ ss i ent entdata etype pts new_lines final_ss)
  (princ "\n==== 智能连接合并 ====")
  (setq ss (ssget '((0 . "LINE,ARC,CIRCLE,LWPOLYLINE"))))
  (if (null ss)
    (progn (princ "\n未选择对象！") (princ) (exit)))

  (princ "\n正在提取端点...")
  (setq i 0)
  (repeat (sslength ss)
    (setq ent (ssname ss i))
    (setq entdata (entget ent))
    (setq etype (cdr (assoc 0 entdata)))
    (setq pts (append pts (get-endpoints ent)))
    (setq i (1+ i))
  )

  (princ "\n正在连接最近端点...")
  (setq new_lines (connect-closest pts))
  (setq new_lines (remove-longest-line new_lines))

  (princ "\n正在合并...")
  (setq final_ss (ssadd))
  (setq i 0)
  (repeat (sslength ss)
    (ssadd (ssname ss i) final_ss)
    (setq i (1+ i))
  )
  (foreach ent new_lines
    (if ent (ssadd ent final_ss))
  )

  (command "_pedit" "_m" final_ss "" "_y" "_j" "0" "")
  (princ "\n==== 完成！ ====")
  (princ)
)

(defun get-endpoints (ent / ed t1 t2 closed)
  (setq ed (entget ent))
  (cond
    ((= (cdr (assoc 0 ed)) "LINE")
     (list (cdr (assoc 10 ed)) (cdr (assoc 11 ed))))
    ((= (cdr (assoc 0 ed)) "ARC")
     (list (cdr (assoc 10 ed)) (cdr (assoc 11 ed))))
    ((= (cdr (assoc 0 ed)) "LWPOLYLINE")
     (setq closed (logand (cdr (assoc 70 ed)) 1))
     (if (zerop closed)
       (list (cdr (assoc 10 (reverse ed))) (cdr (assoc 10 ed)))
       nil
     )
    )
    ((= (cdr (assoc 0 ed)) "CIRCLE") nil)
    (t nil)
  )
)

(defun connect-closest (pts / p1 p2 minDist a b dist remain ent new_lines)
  (setq remain pts new_lines nil)
  (while (>= (length remain) 2)
    (setq minDist 1e99 p1 nil p2 nil)
    (foreach a remain
      (foreach b remain
        (if (not (equal a b 1e-8))
          (progn
            (setq dist (distance a b))
            (if (< dist minDist)
              (setq minDist dist p1 a p2 b)
            )
          )
        )
      )
    )
    (if (and p1 p2)
      (progn
        (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2) '(8 . "0")))
        (setq ent (entlast))
        (setq new_lines (cons ent new_lines))
      )
    )
    (setq remain (vl-remove-if '(lambda (x) (or (equal x p1 1e-8) (equal x p2 1e-8))) remain))
  )
  new_lines
)

(defun remove-longest-line (lines / e ed p1 p2 d maxd maxe)
  (if (<= (length lines) 1)
    lines
    (progn
      (setq maxd 0.0 maxe nil)
      (foreach e lines
        (setq ed (entget e))
        (setq p1 (cdr (assoc 10 ed)) p2 (cdr (assoc 11 ed)))
        (setq d (distance p1 p2))
        (if (> d maxd)
          (setq maxd d maxe e)
        )
      )
      (entdel maxe)
      (vl-remove maxe lines)
    )
  )
)

(princ "\nJL 加载完成")
(princ)