supercorn 发表于 2004-9-27 08:19:00

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

<FONT color=#990000>由各种线：样条曲线，直线，圆弧，等等线条组成的不规则闭合区域，如果只在里面只用鼠标点一下就创建相应的面域。并不断提示：选取封闭域内一点。直至回车结束？用addregion方法创建是不是有点问题？</FONT>


<FONT color=#990000>功能如同：</FONT>


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<BR>;;;fbymj.lsp 封闭域面积(标注)<BR>;;;单位：平方米；画图单位1:1<BR>;;;-- <A href="mailto:XYP@bsedi.com" target="_blank" >XYP@bsedi.com</A><BR>;;;2004.07.27<BR>;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<BR>(prompt "\n\r                                       加载封闭域面积标注程序。")<BR>(defun c:fbymj(/ pt pt1 en aa)<BR>       (cmdla0)<BR>       (setq pt (getpoint "\n选取封闭域内一点: "))<BR>       (while pt<BR>                       (setq pt1 pt)<BR>                       (mkla"封闭域辅助线"8)<BR>                       (command "bpoly" pt "")<BR>                       (setq en (entlast))<BR>                       (if        (/= en nil)<BR>                                       (progn<BR>        (command "area" "o" en)<BR>        (setq aa (getvar "area"))<BR>        (redraw en 4);1标准2空白3高亮4低亮<BR>        ;(alert (strcat "面积=" (rtos (/ aa 1000000) 2 2)));;;此句可以显示面积数（单位平方米）<BR>                                       )<BR>                       )<BR>                       ;(entdel en);;;此句可以删除“封闭域辅助线”<BR>                       (mkla"面积标注"4)<BR>                       (command"text""mc" pt1 "300" "0" (rtos (/ aa 1000000) 2 2))<BR>                       (setq pt (getpoint "\n选取封闭域内一点: "))<BR>       )<BR>       ;(prin1)<BR>       (cmdla1)<BR>       (pxyp"fbymj                                       (封闭域面积)")<BR>)<BR>;;; 保存原有系统变量，设置程序运行时的系统变量<BR>(Defun cmdla0 ()<BR>       (Setq        cmdech (Getvar "Cmdecho")<BR>        oom                       (Getvar "Orthomode")<BR>        osm                       (Getvar "Osmode")<BR>        la                               (Getvar "Clayer")<BR>       )<BR>       (Setvar "Cmdecho" 0)<BR>       (Setvar "Regenmode" 0)<BR>)


;;; 建图层: (mala "层名" 颜色号)<BR>(Defun MKLA (a b)<BR>       (If (= (Tblsearch "layer" a) nil)<BR>                       (Command "layer" "m" a "c" b a "")<BR>                       (Command "layer" "t" a "s" a "c" b a "")<BR>       )<BR>)


;;; 恢复原有系统变量<BR>(Defun cmdla1 ();(/ cmdech LA oom osm)<BR>       (Setvar "Cmdecho" cmdech)<BR>       (Setvar "Clayer" LA)<BR>       (Setvar "Orthomode" oom)<BR>       (Setvar "Osmode" osm)<BR>       (setvar "regenmode" 1)<BR>       (Terpri)<BR>       (Princ)<BR>)


;;;* 显示命令简写<BR>(DEFUN PXYP (TXT1)<BR>       (SETQ        TXT1 (STRCAT "\n\r                                       程序命令: "       TXT1 "                                       -- <A href="mailto:XYP@bsedi.com" target="_blank" >XYP@bsedi.com</A>"))<BR>       (PRINC TXT1)<BR>       (Princ)<BR>);defun


(pxyp"fbymj                                       (封闭域面积)")

雪山飞狐_lzh 发表于 2004-9-27 10:13:00

<A href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=26425" target="_blank" >http://bbs.mjtd.com/forum.php?mod=viewthread&tid=26425</A>


看看alin斑竹在2楼的回帖


Lisp的问题怎么跑到VBA版了？

supercorn 发表于 2004-9-27 11:30:00

不是啊。我是要求用VBA完成LISP的功能呀！
页: [1]
查看完整版本: 再请教斑主lzh741206，如何根据输入的点创建不规则面域？