[求助]：一个相同内容文字按最短的距离相连线的程序，但不知出错在哪里，大家帮忙看

userzhluserzhl

;相同内容文字按最短的距离相连线 明经 zzxxqq 2009.1.14改
(defun c:AA ( / dst ent i j k ln pt0 pt1 ptlst ptmp s1 ss)
(command ".ucs" "w")
  (if (and (setq s1 (entsel "\n请选取要连线的其中一个文字 :"))
           (setq ent (entget(car s1)))
           (= (cdr(assoc 0 ent)) "TEXT"))
   (prompt "\n框选所要连线的范围：")
   (if (setq ss (ssget (list '(0 . "TEXT") (assoc 1 ent)))) (progn
    (setq j -1 ptlst (list))
    (repeat (sslength ss)
     (setq ent (entget(ssname ss (setq j (1+ j))))
           ptlst (cons (cdr(assoc 10 ent)) ptlst))
    )
    (setq pt0 (getpoint "\n请点取开始连线的起始点 :")
          i 1 k nil dst (distance pt0 (car ptlst)) ln (length ptlst))
    (repeat (1- ln)
     (setq pt1 (nth i ptlst))
     (if (< (distance pt0 pt1) dst) (setq dst (distance pt0 pt1) k i))
     (setq i (1+ i))
    )
;   (print ptlst) (princ k)
    (if k
     (setq pt0 (nth k ptlst)
           ptmp (list pt0)
           ptlst (append
     (reverse (cdr(member pt0 (reverse ptlst)))) (cdr(member pt0 ptlst))))
    )
    (print ptmp) (print ptlst)
    (while (> (length ptlst) 1)
     (setq dst (distance (car ptlst) pt0) j 1 k nil)
     (while (< j (1- (length ptlst)))
      (setq pt1 (nth j ptlst))
      (if (< (distance pt0 pt1) dst) (setq dst (distance pt0 pt1) k j))
      (setq j (1+ j))
     )
     (if k
      (setq pt0 (nth k ptlst) ptmp (append ptmp (list pt0))
            ptlst (append
                  (reverse(cdr(member pt0 (reverse ptlst)))) (cdr(member pt0 ptlst))))
      (setq pt0 (car ptlst) ptmp (append ptmp (list pt0)) ptlst (cdr ptlst))
     )
     (print ptmp) (print ptlst)
    )
    (setq ptlst (append ptmp ptlst))
    (setq i 0)
    (command ".pline" (car ptlst))
    (repeat (1- (length ptlst))
     (command (nth (setq i (1+ i)) ptlst))
    )
    (command "")
    (command "_.change" (entlast) "" "p" "c" 1 "")
   ))
  )
  (command ".ucs" "p")
  (princ)
)
命令: aa .ucs
当前 UCS 名称: *世界*
指定 UCS 的原点或 [面(F)/命名(NA)/对象(OB)/上一个(P)/视图(V)/世界(W)/X/Y/Z/Z 轴(ZA)] <世界>: w
命令:
请选取要连线的其中一个文字 :
框选所要连线的范围：.ucs
当前 UCS 名称: *世界*
指定 UCS 的原点或 [面(F)/命名(NA)/对象(OB)/上一个(P)/视图(V)/世界(W)/X/Y/Z/Z 轴(ZA)] <世界>: p
命令:


哪位高手能帮帮忙看看错在哪里，急用，谢谢

Free-Lancer

最好弄个 dwg 好测试