点选封闭边界线标注面积
本帖最后由 作者 于 2008-11-1 1:39:46 编辑 <br /><br /> <p>xyp1964版主的面积标注程序（<a href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=26245">http://bbs.mjtd.com/forum.php?mod=viewthread&tid=26245</a>）很好用，特别在地块面积标注时。但是当想标注包含许多闭合线的大闭合时，就必需复制到别的地方再用xyp1964版主的mjbz.vlx程序点选大闭合线域内才能标注，而且不能很好地判断标注面积是那个封闭域的，因此通过点选封闭边界线标注面积是有必要的，在2006高亮边界功能下可以很好的判断标注了哪块封闭的面积。现在提供一个点选封闭边界线标注面积的程序源码，供大家研究研究，有兴趣的朋友也来丰富一下这个程序。<br/><br/>但是程序把平方数及亩数一起标注了，但我认为加条件判断，标注时可以选择平方米，亩，公顷进行标注更加科学些，我修改如下，应是标注出来的面积，第一次错误，第二次才正确不知道是什么原因。</p><p><font color="#ff0000">源码</font></p><p>(defun c:mj( / vcoo vcmd vbm x loop ss fe el vc ent etype en in)<br/> (setq vcoo (getvar "coords"))<br/> (setq vcmd (getvar "cmdecho"))<br/> (setq vbm (getvar "blipmode"))<br/> (setvar "coords" 0)<br/> (setvar "cmdecho" 0)<br/> (setvar "blipmode" 0)<br/> (seterrhnd)<br/> (if (null textsize) (setq textsize 1.0))<br/> (setq x (getreal (strcat "文字高度 <" (rtos textsize 2 4) ">: ")))<br/> (if x (setq textsize x))<br/> (if (null dec) (setq dec 3))<br/> (setq x (getint (strcat "小数精确位数 <" (rtos dec 2 0) ">: ")))<br/> (if x (setq dec x))<br/>;; (command "style" "" "" "" "" "" "" "" "")<br/> ;;; (command "-style" "standard4" "simhei.ttf" "" "" "" "" "") ;<br/> <br/> <br/> (graphscr)<br/> (setq loop t)<br/> (while loop<br/> (setq ss (car (entsel "\n请选择闭合多线段或边界: ")))<br/> (if (null ss) (setq ent nil loop nil) (setq ent (entget ss)))<br/> (if loop<br/> (progn<br/> (redraw ss 3)<br/> (setq etype (cdr (assoc 0 ent)) el (list ss))<br/> (cond ((= etype "CIRCLE") (setq loop1 nil fe nil))<br/> ((= etype "POLYLINE") (setq loop1 nil fe nil))<br/> ((= etype "LWPOLYLINE") (setq loop1 nil fe nil))<br/> ((= etype "LINE") (setq loop1 t fe ent vc nil))<br/> (t (setq loop1 nil fe nil ent nil))<br/> )<br/> (while loop1<br/> (setq ss (car (entsel "\n请选择圆,多线段或其他封闭边界线: ")))<br/> (if (null ss) (setq loop1 nil) (setq en (entget ss)))<br/> (if (and loop1 (= (cdr (assoc 0 en)) "LINE"))<br/> (if (setq in (ipo2l ent en))<br/> (progn<br/> (setq vc (append vc (list in)))<br/> (setq el (append el (list ss)) ent en)<br/> (redraw ss 3)<br/> )<br/> )<br/> )<br/> )<br/> (if fe<br/> (if (and (setq ent (ipo2l ent fe)) (not (equal ent in)))<br/> (setq vc (append vc (list ent)))<br/> (progn (mapcar '(lambda (x) (redraw x 4)) el) (setq ent nil))<br/> )<br/> )<br/> (if ent<br/> (progn<br/> (bdist)<br/> (if (/= etype "LINE") (command "area" "e" ss)<br/> (mapcar '(lambda (x) (command x)) (append '("area") vc '(""))))<br/> (setq ar1 0.0)<br/> (arec)<br/> (setq in (getpoint "\nPosition: "))<br/> (mapcar '(lambda (x) (redraw x 4)) el)<br/> (if in<br/> (progn<br/> ;;;(command "text" "ce" in textsize "0" (rtos (getvar "area") 2 dec))<br/> (if (>= ar1 0.001) ;start of if1<br/> (progn<br/> (setq ts1 (* textsize 1) len (/ ts1 1.5)<br/> po (list (car in) (- (cadr in) (+ len ts1)))<br/> ar1 (rtos ar1 2 dec)<br/> )<br/> (command "text" "ce" po ts1 "" ar1)<br/> ));end of if1<br/> )<br/> ))<br/> (princ "\nRequires circle or closed polygon.")<br/> )<br/> )<br/> )<br/> )<br/> (clrerrhnd)<br/> (setvar "coords" vcoo)<br/> (setvar "cmdecho" vcmd)<br/> (setvar "blipmode" vbm)<br/> (princ)<br/>)</p><p>(defun arec()<br/> (setq ar (getvar "area"))<br/> (setq ar (rtos (setq ar1 (/ ar (/ 2000.0 3.0))) 2 2))<br/> (setq ar (strcat "\nArec=" ar))<br/> (princ ar)<br/>)<br/></p><p></p><p><font color="#ff0000">加个判断</font></p><p><br/><font color="#ff0000"> (setq BL-bz (getkword "\n请选择标注单位 A-平方米/B-亩/C-公顷.<平方米>:"))<br/>(setq aa (getvar "area"))<br/>(if ent<br/> (progn<br/> (bdist)<br/> (if (/= etype "LINE") (command "area" "e" ss)<br/> (mapcar '(lambda (x) (command x)) (append '("area") vc '(""))))<br/> (setq ar1 0.0)<br/> (arec)<br/> (setq in (getpoint "\nPosition: "))<br/> (mapcar '(lambda (x) (redraw x 4)) el)</font></p><p><br/><font color="#ff0000"> (if in<br/> (progn<br/> (setq BL-bz (if BL-bz BL-bz "A"))</font></p><p><font color="#ff0000"> <br/> (if (= bl-bz "A")(setq aa (rtos (/ aa 1.0) 2 2)))<br/> (if (= bl-bz "B")(setq aa (rtos (/ aa (/ 2000.0 3)) 2 2)))<br/> (if (= bl-bz "C")(setq aa (rtos (/ aa 10000.0) 2 4)))<br/> <br/> )<br/> <br/> )<br/> (command "text" "ce" in textsize "0" aa)</font></p> 没有人告诉一下么？回复：（kezhouljc）点选封闭边界线标注面积
<p>出现“错误: no function definition: SETERRHND”是怎么回事，该怎么办呢？</p> sky1234567发表于2008-12-14 14:45:00static/image/common/back.gif出现“错误: no function definition: SETERRHND”是怎么回事，该怎么办呢？<p>no function definition: SETERRHND</p><p>没有函数定义：SETERRHND</p> 面积标注待修改 function XML() {
} <p>面积标注－对话框:</p><p></p> 少一个函数，用不了。。：）
页:
[1]