[LISP程序]：请帮修改程序

c803

下面程序在R14下能运行,在cad2002下却不行,请帮忙


;程序用于标注边长，有三种方式可选用：自动（A），可用于标注整条复合线；单段（S），可用于标注复合线
;中的一段或几段；点选（P），可用于标注所选两点的间距。
;使用"自动（S）"时，向外选方向点应靠近线段的中部。
;
;
;* * ** * **** * *  * * * * * * * ** * * * * * * * * * ** * * * * * * **  ** *  * ** ** * * * * *
(defun texver (a / bb n i)
       (setq bb (entget a) n (length bb) i 0 pl '())
       (while (< i n)             
              (setq b (nth i bb))
              (if (= (car b) 10) (setq pl (cons (cdr b) pl)))                 
              (setq i (1+ i))
       )      
)
(defun qan (a / bb n i)
       (setq bb (entget a) n (length bb) i 0 an '())
       (while (< i n)             
              (setq b (nth i bb))
              (if (= (car b) 42) (setq an (cons (cdr b) an)))                 
              (setq i (1+ i))
       )      
)
(defun ic (co)
    (if (> co (* 2 pi)) (setq co (- co (* 2 pi))))
    (if (< co 0) (setq co (+ co (* 2 pi))))
)
(defun pmid (pt1 pt2)
   (mapcar '/ (mapcar '+ pt1 pt2) '(2 2))
)
(defun wr (pt aa ddi)
  (setvar "osmode" 0)
  (if (and (> aa (* 0.5 pi)) (< aa (* 1.5 pi))) (setq aa (- aa pi)))
  (ic aa)
  ;(setq fee (getint "请输入边长精确位数: <2> "))         
  (command "text" "j" "m" pt h aa (rtos ddi 2 2))
  (command "change" "l" "" "p" "la" "cp" "c" "4" "")
)
(defun p-a (p p1 p2 / aa b b1 b2 sina sina1 sina2 cosa cosa1 cosa2)
  (command "area" p p1 p2 "")
  (setq aa (getvar "AREA"))
  (setq b (distance p1 p2) b1 (distance p p2) b2 (distance p p1))
  (setq sina (/ (* 2 aa) b1 b2)
       sina1 (/ (* 2 aa) b b2)
       sina2 (/ (* 2 aa) b1 b)
  )
  (setq cosa (/ (- (+ (* b2 b2) (* b1 b1)) (* b b)) (* 2 b2 b1))
       cosa1 (/ (- (+ (* b2 b2) (* b b)) (* b1 b1)) (* 2 b2 b))
       cosa2 (/ (- (+ (* b b) (* b1 b1)) (* b2 b2)) (* 2 b b1))
  )
  (if (= cosa 0) (setq a (/ pi 2)) (setq a (atan (/ sina cosa))))
  (if (= cosa1 0) (setq a1 (/ pi 2)) (setq a1 (atan (/ sina1 cosa1))))
  (if (= cosa2 0) (setq a2 (/ pi 2)) (setq a2 (atan (/ sina2 cosa2))))
  (if (< a 0) (setq a (+ pi a)))
  (if (< a1 0) (setq a1 (+ pi a1)))
  (if (< a2 0) (setq a2 (+ pi a2)))
)
;**** **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** ****
(defun c:wcp (/ sca1 h t pt2 pt3 n ptm a di ss pl pt ii di1 a1 a2 coro fl an i)
(command "_.undo" "begin")
(setvar "cmdecho" 0)
(command "style" "" "" "" "1.0" "" "" "" "")
(command "layer" "n" "cp" "")
(if (= sca nil) (setq sca 1000))
(setq sca1 (getint (strcat "输入比例尺分母<" (itoa sca) ">:")))
(if (= sca1 nil) (setq sca1 sca) (setq sca sca1))
(setq h (* 0.0020 sca))
(setq h1 (* 0.0030 sca))
(setvar "aunits" 3)
(setvar "ANGBASE" 0)
(setvar "angdir" 0)
(setq t (strcase (getstring "Auto自动处理/Point点选/Single单段处理<A>:")))
(if (= t "") (setq t "A"))
   (if (= t "P") (progn
      (setvar "osmode" 33)
      (setq pt2 (getpoint "从点：") pt3 (getpoint "到点："))
      (while pt3
          (setq ptm (pmid pt2 pt3) a (angle pt2 pt3) di (distance pt2 pt3)
                ptm (polar ptm (+ a (* 0.5 pi)) (* h1 1)))
          (wr ptm a di)
          (setvar "osmode" 33)
          (setq pt2 pt3  pt3 (getpoint "到点："))

      )
      (setvar "osmode" 0)
   ))
   (if (= t "S") (progn
      (setq ss (car (entsel)))              
      (texver ss)
      (setq n (length pl) pl (reverse (cons (nth (- n 1) pl) pl)))      
      (setq pt (getpoint "选择线段近点:"))
      (while pt
          (setq i 0 ii nil di1 500)
          (while (< i n)
             (setq pt2 (nth i pl) pt3 (nth (+ 1 i) pl))
             (p-a pt pt2 pt3)
             (if (and (< a1 1.5708) (< a2 1.5708)) (progn
                 (setq di (* (distance pt2 pt) (sin a1)))
                 (if (< di di1) (setq di1 di ii i))
             ))
             (setq i (1+ i))
          )
          (if ii (progn
             (setq pt2 (nth ii pl) pt3 (nth (+ 1 ii) pl) a1 (angle pt2 pt)
                  a2 (angle pt2 pt3) ptm (pmid pt2 pt3) di (distance pt2 pt3))     
             (if (< a2 pi) (cond ((and (> a1 a2) (< a1 (+ pi a2))) (setq a (+ a2 (* 0.5 pi))))
                               (t (setq a (- a2 (* 0.5 pi))))
                           )
                           (cond (( or (> a1 a2) (< a1 (- a2 pi))) (setq a (+ a2 (* 0.5 pi))))
                               (t (setq a (- a2 (* 0.5 pi))))
                           )
             )
            (setq ptm (polar ptm a (* 1 h1)))
            (wr ptm a2 di)
         ))
          (setq pt (getpoint "选择线段近点:"))
      )
   ))
   (if (= t "A") (progn
      (setq ss (car (entsel)))              
      (texver ss)
      (setq coro (cdr (assoc 70 (entget ss))))