斑竹兄弟帮我看看土方计算程序为什么不能用？

朱天豪

<pre>各位兄弟，你们好！</pre><pre>       帮我看看这个土方计算程序为什么不能用啊，我加载这个程序后，选择闭合线及高程时，</pre><pre>      出现什么除数为0，什么错误。望各位测绘兄弟帮我看看，兄弟感谢了</pre><pre>(defun c:tf (/ a nb np hr n i ai b la h hi s p p1)
  (princ "选择高程及面积:")
  (setq a (ssget '((0 . "text"))))
  (setq na 0)
  (setq nb 0)
  (setq hp 0)
  (setq hr 0)
  (setq n (sslength a))
  (setq i 0)
  (repeat n
    (setq ai (ssname a i))
    (setq i (+ i 1))
    (setq b (entget ai))
    (setq la (cdr (assoc 8 b)))
    (setq h (cdr (assoc 1 b)))
    (setq hi (atof h))
    (if        (or
          (= la "YGC")
          (= la "ygc")
        )
      (progn
        (setq na (+ na 1))
        (setq hp (+ hp hi))
      )
    )
    (if        (or
          (= la "XGC")
          (= la "xgc")
        )
      (progn
        (setq nb (+ nb 1))
        (setq hr (+ hr hi))
      )
    )
    (if        (or
          (= la "MJ")
          (= la "mj")
        )
      (progn
        (setq s (substr h 3))
        (setq s (atof s))
        (setq p (cdr (assoc 10 b)))
        (setq p1 (polar p 2 2))
      )
    )
  )
  (setq hp (/ hp na))
  ;(setq hp 11)
  (setq hr (/ hr nb))
  (setq v 0)
  (setq v (* s (- hr hp)))
  (setq v (rtos v 2 2))
  (setq s (strcat "V=" v))
  (setq        pt1 (mapcar
              '+
              pt1
              '(0.8 0 0)
            )
  )
  (setq e (list (cons 0 "text") (cons 1 s) (cons 10 p1) (cons 40 0.8)))
  (entmake e)
)
(defun c:v ()
  (setq a (ssget '((0 . "TEXT"))))
  (setq n (sslength a))
  (setq i 0)
  (setq s 0)
  (repeat n
    (setq ai (ssname a i))
    (setq i (+ i 1))
    (setq b (entget ai))
    (setq attr (cdr (assoc 0 b)))
    (if        (= attr "TEXT")
      (progn
        (setq t (cdr (assoc 1 b)))
        (if (&lt; (atof t) 0.000001)
          (progn
            (setq si (atof (substr t 3)))
            (setq s (+ s si))
          )
        )
      )
    )
  )
  (setq p (getpoint "s_location:"))
  (setq s (strcat "V=" (rtos s 2 2)))
  (command "text" p 1 "" s)
)

(defun c:s ()
  (setq a (ssget '((0 . "TEXT"))))
  (setq n (sslength a))
  (setq i 0)
  (setq s 0)
  (repeat n
    (setq ai (ssname a i))
    (setq i (+ i 1))
    (setq b (entget ai))
    (setq attr (cdr (assoc 0 b)))
    (if        (= attr "TEXT")
      (progn
        (setq t (cdr (assoc 1 b)))
        (if (&lt; (atof t) 0.000001)
          (progn
            (setq si (atof (substr t 3)))
            (setq s (+ s si))
          )
        )
      )
    )
  )
  (setq p (getpoint "s_location:"))
  (setq s (strcat "S=" (rtos s 2 2)))
  (command "text" p 1 "" s)
)
(defun c:aa (/ p a s)
  (setq e (entlast))
  (setq p (getpoint "input text point:"))
  (command "BOUNDARY" p "")
  (if (equal e (entlast))
    (alert "BOUNDARY  ERROR ！")
    (progn
      (command "AREA" "O" "LAST")
      (entdel (entlast))
      (setq a (getvar "AREA"))
      ;(setq zzza(/ a 666.66667))
      ;(setq zzza(rtos zzza 2 2))
      ;(setq zzza(strcat "（合" zzza "亩）"))
      (setq s (rtos a 2 2))
      (setq s (strcat "S=" S))
      ;(setq s (strcat s "平方米" zzza))
      (command "text" p "0.8" "" s)
    )
  )
)
(defun c:ygc ()
  (setq pt1 (getpoint "输入设计高点位？"))
  (setq        pt1 (mapcar
              '+
              pt1
              '(0.6 -1.5 0)
            )
  )
  (setq str "7.10")
  (setq        e (list        (cons 0 "text")
                (cons 1 str)
                (cons 8 "YGC")
                (cons 10 pt1)
                (cons 40 1)
          )
  )
  (entmake e)
)
(defun c:xgc ()
  (setq pt1 (getpoint "点位？"))
  (setq        pt1 (mapcar
              '+
              pt1
              '(0.6 1.5 0)
            )
  )
  (setq str (getstring "Enter text:"))
  (setq        e (list        (cons 0 "text")
                (cons 1 str)
                (cons 8 "XGC")
                (cons 10 pt1)
                (cons 40 1)
          )
  )
  (entmake e)
)
(defun tfxyz (ssent / len k ai g xyz x y z dxfvl vl)
  (setq vl '())
  (if ssent
    (progn
      (setq len        (sslength ssent)
            k        0
      )
      (repeat len
        (setq ai (ssname ssent k)
              k         (1+ k)
        )
        (setq g (entget ai))
        (setq xyz (cdr (assoc 10 g))
              x          (car xyz)
              y          (cadr xyz)
        )
        (if (equal (strcase typ) "TEXT")
          (setq z (atof (cdr (assoc 1 g))))
          (setq z (caddr xyz))
        )
        (setq dxfvl (list x y z))
        (setq vl (append
                   vl
                   (list dxfvl)
                 )
        )
      )
    )
    (setq vl nil)
  )
  (setq vl vl)
)
(defun tfapf (fna str)
  (setq fn (open fna "a"))
  (princ str fn)
  (close fn)
)
(defun c:zz (/ pa pb a b pc ab ac c)
  (setq        pa (getpoint "Specify first point:")
        pb (getpoint "Specify second point:")
        a  (getreal "Specify first High:")
        b  (getreal "Specify second High:")
  )
  (while (setq pc (getpoint "Specify start point:")
               ab (distance (list (car pa) (cadr pa))
                            (list (car pb)
                                  (cadr pb)
                            )
                  )
               ac (distance (list (car pa) (cadr pa))
                            (list (car pc)
                                  (cadr pc)
                            )
                  )
               c  (+ a (* ac (/ (- b a) ab)))
         )
    (setq e (list (cons 0 "TEXT")
                  (cons 1 (rtos c 2 2))
                  (cons 8 "YGC")
                  (cons 10 pc)
                  (cons 40 1.0)
                  (cons 62 1)
            )
    )
    (entmake e)
  )
)
(defun tftext (tf_la hh cc / pc c e)
  (setq        pc (getpoint)
        c  (getreal)
  )
  (setq        e (list        (cons 0 "TEXT")
                (cons 1 (rtos c 2 2))
                (cons 8 tf_la)
                (cons 10 pc)
                (cons 40 hh)
                (cons 62 cc)
          )
  )
  (entmake e)
)
(defun c:xx () (tftext "sdg" 1.0 1))
(defun c:ss () (tftext "sjg" 1.5 6))
(defun c:bb (/ a b pa pb ab c e)
  (setq        a  (getreal "高程:")
        b  (getreal "请输入比例系数:")
        pa (getpoint "起点:")
  )
  (while (setq pb (getpoint "到下一个点文本位置:")
               ab (distance (list (car pa) (cadr pa))
                            (list (car pb)
                                  (cadr pb)
                            )
                  )
               c  (+ a (* ab b))
         )
    (setq e (list (cons 0 "TEXT")
                  (cons 1 (rtos c 2 2))
                  (cons 8 "YGC")
                  (cons 10 pb)
                  (cons 40 8.0)
                  (cons 62 1)
            )
    )
    (entmake e)
  )
)
(defun c:sdg (/ i lts typ i p0 d str sd sj e px py pe z lts)
  (setvar "dimzin" 3)
  (SETQ TYP "TEXT")
  (prompt "起点距离")
  (setq i (getdist))
  (prompt "剖面线起点:")
  (while (setq p0 (getpoint))
    (setq d (strcat "0+" (rtos i 2 2) "\n"))
    (tfapf "d:/sdg.txt" d)
    (tfapf "d:/sjg.txt" d)
    (setq str (ssget '((0 . "TEXT"))))
    (setq sd (ssget "p" '((8 . "sdg"))))
    (command "select" str "")
    (setq sj (ssget "p" '((8 . "sjg"))))
    (command "chprop" str "" "c" 2 "")
    (foreach e (tfxyz sd)
      (setq px (car p0)
            py (cadr p0)
            p0 (list px py)
      )
      (setq pe (list (car e) (cadr e)))
      (setq d (distance p0 pe))
      (setq d (rtos d 2 2))
      (setq z (rtos (caddr e) 2 2))
      (tfapf "d:/sdg.txt" d)
      (tfapf "d:/sdg.txt" "        ")
      (tfapf "d:/sdg.txt" z)
      (tfapf "d:/sdg.txt" "\n")
    )
    (foreach e (tfxyz sj)
      (setq px (car p0)
            py (cadr p0)
            p0 (list px py)
      )
      (setq pe (list (car e) (cadr e)))
      (setq d (distance p0 pe))
      (setq d (rtos d 2 2))
      (setq z (rtos (caddr e) 2 2))
      (tfapf "d:/sjg.txt" d)
      (tfapf "d:/sjg.txt" "        ")
      (tfapf "d:/sjg.txt" z)
      (tfapf "d:/sjg.txt" "\n")
    )
    (prompt "请量取到下一根剖面线的距离")
    (setq lts (getdist))
    (setq i (+ lts i))
    (prompt "剖面线起点:")
  )
)
</pre>