再请教斑主lzh741206，如何根据输入的点创建不规则面域？

supercorn

由各种线：样条曲线，直线，圆弧，等等线条组成的不规则闭合区域，如果只在里面只用鼠标点一下就创建相应的面域。并不断提示：选取封闭域内一点。直至回车结束？用addregion方法创建是不是有点问题？ 功能如同： ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;fbymj.lsp 封闭域面积(标注)
;;;单位：平方米；画图单位1:1
;;;-- XYP@bsedi.com
;;;2004.07.27
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(prompt "\n\r 加载封闭域面积标注程序。")
(defun c:fbymj(/ pt pt1 en aa)
(cmdla0)
(setq pt (getpoint "\n选取封闭域内一点: "))
(while pt
(setq pt1 pt)
(mkla"封闭域辅助线"8)
(command "bpoly" pt "")
(setq en (entlast))
(if (/= en nil)
(progn
(command "area" "o" en)
(setq aa (getvar "area"))
(redraw en 4);1标准2空白3高亮4低亮
;(alert (strcat "面积=" (rtos (/ aa 1000000) 2 2)));;;此句可以显示面积数（单位平方米）
)
)
;(entdel en);;;此句可以删除“封闭域辅助线”
(mkla"面积标注"4)
(command"text""mc" pt1 "300" "0" (rtos (/ aa 1000000) 2 2))
(setq pt (getpoint "\n选取封闭域内一点: "))
)
;(prin1)
(cmdla1)
(pxyp"fbymj (封闭域面积)")
)
;;; 保存原有系统变量，设置程序运行时的系统变量
(Defun cmdla0 ()
(Setq cmdech (Getvar "Cmdecho")
oom (Getvar "Orthomode")
osm (Getvar "Osmode")
la (Getvar "Clayer")
)
(Setvar "Cmdecho" 0)
(Setvar "Regenmode" 0)
) ;;; 建图层: (mala "层名" 颜色号)
(Defun MKLA (a b)
(If (= (Tblsearch "layer" a) nil)
(Command "layer" "m" a "c" b a "")
(Command "layer" "t" a "s" a "c" b a "")
)
) ;;; 恢复原有系统变量
(Defun cmdla1 ();(/ cmdech LA oom osm)
(Setvar "Cmdecho" cmdech)
(Setvar "Clayer" LA)
(Setvar "Orthomode" oom)
(Setvar "Osmode" osm)
(setvar "regenmode" 1)
(Terpri)
(Princ)
) ;;;* 显示命令简写
(DEFUN PXYP (TXT1)
(SETQ TXT1 (STRCAT "\n\r 程序命令: " TXT1 " -- XYP@bsedi.com"))
(PRINC TXT1)
(Princ)
);defun (pxyp"fbymj (封闭域面积)")

雪山飞狐_lzh

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=26425 看看alin斑竹在2楼的回帖 Lisp的问题怎么跑到VBA版了？

supercorn

不是啊。我是要求用VBA完成LISP的功能呀！