请教，还是关于子程序编写的问题。

lxdz443

下面的程序中，我把fid这个子程序写成了(defun fid (a b) (cdr (assoc a b)))，现在程序只能运行到(= s 3)(= s 4)这个地方，请教是哪里的问题？
(Defun ima (a b / x y)
  (setq        x (dimx_tile a)
        y (dimy_tile a)
  )
  (start_image a)
  (fill_image 0 0 x y 0)
  (slide_image 0 0 x y b)
  (end_image)
)

(defun fid (a b) (cdr (assoc a b)))

(Defun set1 ()
  (if (not (new_dialog "GH1" id))
    (exit)
  )
  (mapcar '(lambda (x y) (ima x y))
          (list "i1" "i2" "i3" "i4" "i5" "i6")
          (list        "DX(GH1)" "DX(GH2)" "DX(GH3)" "DX(GH4)"        "DX(GH5)"
                "DX(GH6)")
  )
  (action_tile "i1" "(done_dialog 1)")
  (action_tile "i2" "(done_dialog 2)")
  (action_tile "i3" "(done_dialog 3)")
  (action_tile "i4" "(done_dialog 4)")
  (action_tile "i5" "(done_dialog 5)")
  (action_tile "i6" "(done_dialog 6)")
  (setq s1 (start_dialog))
)



(Defun C:GHD (/ id s sc p1 p2 e le ht)
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "plinewid" 0)
  (setvar "orthomode" 0)
  (setq        sc (getvar "USERR1")
        ht (getvar "userr2")
  )
  (command "LAYER" "m" "$GH" "c" "3" "" "")
  (setq        id (load_dialog "DL.DCL")
        s  1
  )
  (while (/= s 0)
    (if        (not (new_dialog "GH" id))
      (exit)
    )
    (ima "I" "DX(GH0)")
    (action_tile "k1"  "(setq a (get_tile \"a\")) (done_dialog 1)")
    (action_tile "k2" "(done_dialog 2)")
    (action_tile "k3" "(done_dialog 3)")
    (action_tile "k4" "(done_dialog 4)")
    (action_tile "k5" "(done_dialog 5)")
    (action_tile "cancel" "(done_dialog 0)")
    (setq s (start_dialog))
    (cond
      ((= s 1)
       (princ "\n插入点:")
       (command        "INSERT" "GHWX" "X" (atof a) "Y" (atof a) "Z" (atof a)        pause)
       (princ "\n旋转角:")
       (command pause "explode" (entlast) "CHANGE"        (entlast) "" "P" "la" "$GH" ""  )
      )
      ((= s 2)
       (princ "\n请直接使用光标夹点方式调整图形外轮廓!!")
       (setq s 0)
      )
      ((= s 3)
       (while
         (not
           (and        (setq e (car (entsel "\n点取计算面积的图形轮廓.")))
                (= (fid 0 (entget e)) "POLYLINE")
           )
         )
       )
       (command "AREA" "E" E)
       (princ
         (strcat "\n面积: "
                 (rtos (* (/ 1 sc) (/ 1 sc) (getvar "area")) 2 1)
                 " 平方米 ."
         )
       )
      )
      ((= s 4)
       (set1)
       (while (not (and        (setq e (car (entsel "\n点取定义的图形轮廓.")))
                        (= (fid 0 (setq le (entget e))) "POLYLINE")
                   )
              )
       )
       (cond
         ((= s1 1)
          (setq        p1 (fid 10 (entget (setq e (entnext e))))
                kk 1
                p0 p1
          )
          (while
            (= (fid 0 (setq le (entget (setq e (entnext e))))) "VERTEX")
             (setq p2 (fid 10 le)
                   a  (angle p1 p2)
                   p1 p2
             )
             (if (> (distance p0 p2) 1.3)
               (setq kk        1
                     p0        p2
               )
               (setq kk nil)
             )
             (if kk
               (command "LINE" p2 (polar p2 (- a (* pi 0.5)) 1) "")
             )
          )
         )
         ((= s1 2)
          (setq        p1 (fid 10 (entget (setq e (entnext e))))
                kk 1
                p0 p1
          )
          (while
            (= (fid 0 (setq le (entget (setq e (entnext e))))) "VERTEX")
             (setq p2 (fid 10 le)
                   a  (angle p1 p2)
                   p1 p2
             )
             (if (> (distance p0 p2) 1.3)
               (setq kk        1
                     p0        p2
               )
               (setq kk nil)
             )
             (if kk
               (command "LINE" p2 (polar p2 (+ a (* pi 0.5)) 1) "")
             )
          )
         )
         ((or (= s1 3) (= s1 4))
          (setq        p1 (fid 10 (entget (setq e (entnext e))))
                kk 1
                p0 p1
          )
          (while
            (= (fid 0 (setq le (entget (setq e (entnext e))))) "VERTEX")
             (setq p2 (fid 10 le)
                   a  (angle p1 p2)
                   p1 p2
             )
             (if kk
               (progn (command "TEXT"
                               (polar p2 (+ a (* pi 0.5)) 2)
                               ht
                               0
                               (if (= s1 3)
                                 "湖泊"
                                 "塘"
                               )
                      )
                      (setq kk nil)
               )
             )
          )
         )
         ((= s1 5) (dHATCH "gt9" 5 0 e T))
         ((= s1 6) (dHATCH "gt8" 5 0 e T))
         (T 1)
       )
      )
      ((= s 5)
       (while
         (not (and (setq e (car (entsel "\n点取待放缩的图形轮廓.")))
                   (= (fid 0 (setq le (entget e))) "POLYLINE")
              )
         )
       )
       (princ "\n点取放缩参考点:")
       (command "SCALE" E "" PAUSE)
       (princ "\n输入放缩比例:")
       (command pause)
       (command "AREA" "E" E)
       (princ
         (strcat "\n当前图形面积: "
                 (rtos (* (/ 1 sc) (/ 1 sc) (getvar "area")) 2 1)
                 " 平方米 ."
         )
       )
      )
    )
  )
  (unload_dialog id)
  (setvar "clayer" "0")
  (princ)
)

ZZXXQQ

如果图中的PLINE线是LWPOLYLINE时程序后面无法执行。
建议将(= (fid 0 (setq le (entget e))) "POLYLINE")
改成(wcmatch (fid 0 (setq le (entget e))) "*POLYLINE")

lxdz443

修改后，(= s1 5)(= s1 6)可以用了，(= s1 3)----(= s1 4)还是无法使用。
计算面积提示：错误，除数为零。

ZZXXQQ

lxdz443 发表于 2014-4-11 22:13
修改后，(= s1 5)(= s1 6)可以用了，(= s1 3)----(= s1 4)还是无法使用。
计算面积提示：错误，除数为零。

s=4后面的代码只是针对POLYLINE的，前面的判断不能改。