请教，还是关于子程序编写的问题。
下面的程序中，我把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")
s1
)
(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)
)
如果图中的PLINE线是LWPOLYLINE时程序后面无法执行。
建议将(= (fid 0 (setq le (entget e))) "POLYLINE")
改成(wcmatch (fid 0 (setq le (entget e))) "*POLYLINE") 修改后，(= s1 5)(= s1 6)可以用了，(= s1 3)----(= s1 4)还是无法使用。
计算面积提示：错误，除数为零。 lxdz443 发表于 2014-4-11 22:13 static/image/common/back.gif
修改后，(= s1 5)(= s1 6)可以用了，(= s1 3)----(= s1 4)还是无法使用。
计算面积提示：错误，除数为零。
s=4后面的代码只是针对POLYLINE的，前面的判断不能改。
页:
[1]