[求助]各位大虾，帮忙修改这个小程序，急用阿！

wedg

谢谢，非常感谢！我的已经弄好了，非常感谢！

xyp1964

面积标注－－平方米、亩、公顷：

2. (load "xyp_lib");加载通用函数
3. ;|
4. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
5. 利用以下任何一种方式即可加载和运行通用函数内的所有子程序：
6. 1.在acad.lsp中增加(load"xyp_lib")
7. 2.在每个程序内增加(load"xyp_lib")
8. 3.在command下，输入(load"xyp_lib")
9. 4.在菜单.mnl中增加(load"xyp_lib")
10. 通用函数下载地址:
11. http://bbs.mjtd.com/forum.php?mod=viewthread&tid=37554
12. |;(defun c:ztmj ()
13.    (cmdla0)
14.    (princ "\n注意绘图单位 : 1＝1米")
15.    (SETBL) ;设置出图比例控制字高
16.    (jzhz) ;设置“宋体”字
17.    (setq  h           (* SC 300) ;字高
18.   all-aa 0 ;总面积
19.   BL-bz   (ukword 1 "A B C" "\n请选择标注单位 A-平方米/B-亩/C-公顷" BL-BZ)
20.   bz2       (ukword 1 "Y N" "\n需要标注单位名称吗 Y-标注/N-不标注" BZ2)
21.    )
22.    (while (setq pt (getpoint "\n选取封闭域内一点: "))
23.        (command "bpoly" pt "")
24.        (setq en (entlast))
25.        (if  (/= en nil)
26.            (progn
27.   (command "area" "o" en)
28.   (setq aa (getvar "area"))
29.            )
30.        )
31.        (entdel en)
32.        (mkla "面积标注" 4)
33.        (if  (= bz2 "N")
34.            (cond ((= bl-bz "A") (setq aa (rtos (/ aa 1.0) 2 2)))
35.          ((= bl-bz "B") (setq aa (rtos (/ aa (/ 2000.0 3)) 2 2)))
36.          ((= bl-bz "C") (setq aa (rtos (/ aa 10000.0) 2 4)))
37.            )      
38.            (cond ((= bl-bz "A") (setq aa (strcat (rtos (/ aa 1.0) 2 2) "平方米")))
39.          ((= bl-bz "B") (setq aa (strcat (rtos (/ aa (/ 2000.0 3)) 2 2) "亩")))
40.          ((= bl-bz "C") (setq aa (strcat (rtos (/ aa 10000.0) 2 4) "公顷")))
41.            )
42.        )       (command "text" "j" "mc" pt h "0" aa)
43.        (setq all-aa (+ (atof aa) all-aa))
44.    )
45.    (setq bzzmj (ukword 1 "Y N" "\n是否标注总面积 Y-标注/N-不标注" BZZMJ))
46.    (if (= bzzmj "Y")
47.        (progn
48.            (setq pt (getpoint "\n总面积标注点 : "))
49.            (command "text" "j" "mc" pt h "0" (rtos all-aa 2 2))
50.        )
51.    )
52.    (cmdla1)
53. )
54. (princ "ztmj   (总图面积)")
55. (princ)

(load "xyp_lib");加载通用函数 ;| 如果已经下载xyp_lib并放到搜索路径下可以不再下载! 利用以下任何一种方式即可加载和运行通用函数内的所有子程序： 1.在acad.lsp中增加(load"xyp_lib") 2.在每个程序内增加(load"xyp_lib") 3.在command下，输入(load"xyp_lib") 4.在菜单.mnl中增加(load"xyp_lib") 通用函数下载地址: http://bbs.mjtd.com/forum.php?mod=viewthread&tid=37554 |;(defun c:ztmj ()    (cmdla0)    (princ "\n注意绘图单位 : 1＝1米")    (SETBL) ;设置出图比例控制字高    (jzhz) ;设置“宋体”字    (setq  h           (* SC 300) ;字高   all-aa 0 ;总面积   BL-bz   (ukword 1 "A B C" "\n请选择标注单位 A-平方米/B-亩/C-公顷" BL-BZ)   bz2       (ukword 1 "Y N" "\n需要标注单位名称吗 Y-标注/N-不标注" BZ2)    )    (while (setq pt (getpoint "\n选取封闭域内一点: "))        (command "bpoly" pt "")        (setq en (entlast))        (if  (/= en nil)            (progn   (command "area" "o" en)   (setq aa (getvar "area"))            )        )        (entdel en)        (mkla "面积标注" 4)        (if  (= bz2 "N")            (cond ((= bl-bz "A") (setq aa (rtos (/ aa 1.0) 2 2)))          ((= bl-bz "B") (setq aa (rtos (/ aa (/ 2000.0 3)) 2 2)))          ((= bl-bz "C") (setq aa (rtos (/ aa 10000.0) 2 4)))            )                  (cond ((= bl-bz "A") (setq aa (strcat (rtos (/ aa 1.0) 2 2) "平方米")))          ((= bl-bz "B") (setq aa (strcat (rtos (/ aa (/ 2000.0 3)) 2 2) "亩")))          ((= bl-bz "C") (setq aa (strcat (rtos (/ aa 10000.0) 2 4) "公顷")))            )        )       (command "text" "j" "mc" pt h "0" aa)        (setq all-aa (+ (atof aa) all-aa))    )    (setq bzzmj (ukword 1 "Y N" "\n是否标注总面积 Y-标注/N-不标注" BZZMJ))    (if (= bzzmj "Y")        (progn            (setq pt (getpoint "\n总面积标注点 : "))            (command "text" "j" "mc" pt h "0" (rtos all-aa 2 2))        )    )    (cmdla1) ) (princ "ztmj   (总图面积)") (princ)

wedg

非常好用，感谢楼上的兄弟！

wedg

请问12楼的兄弟， [(SETBL) ;设置出图比例控制字高]，setbl这个函数程序运行的时候显示错误，你能否再检查一下？