<p>多谢<font face="Verdana" color="#61b713"><b>Gu_xl不厌其烦的解答，不过运行时还是需要输入小数位和字高啊</b></font></p>
(defun c:mjqh1 (/ pt1 pt2 zg mj zmj ss LastEntity LastEntity1 gxl-Sel-EntNextAll ssaddsel ) (setierr) ;(initArea) ;;;gxl-Sel-EntNextAll en 返回 en 之后的所有物体选择集，无则返回 nil (defun gxl-Sel-EntNextAll (ent / ss ent1) (setq ss (ssadd)) (while (setq ent1 (entnext ent)) (ssadd ent1 ss) (setq ent ent1) ) (if (= 0 (sslength ss)) nil ss ) ) ;把选择集1中的图元加入到选择集2中 (defun ssaddsel (ss1 ss2 / n k) (setq n (sslength ss1) k 0) (if (> n 0) (while (setq ent (ssname ss1 k)) (ssadd ent ss2) (setq k (1+ k)) ) ) (setq ss2 ss2) ) ;;;gxl-MakeText1 生成文字函数,参数： 标注点 字高 宽比 旋转角 倾角，角度单位：度(defun gxl-MakeText1 (xy Txt ZG KB XZ Qj / xyL TxtL ZGL KBL XZL QJL) (setq xy (trans xy 1 0));;;坐标换算为世界坐标 (SETQ XZ (gxl-Num-DtoR (gxl-Num-Angle->Wcs XZ ))) (setq xyL(cons 10 xy) TxtL (cons 1 Txt) ZGL(cons 40 ZG) KBL(cons 41 KB) XZL(cons 50 XZ) QJL(cons 51 (gxl-Num-DtoR QJ)) ) (setq TextL (list '(0 . "TEXT") '(67 . 0) '(100 . "AcDbText" ) xyL ZGL TxtL XZL KBL QJL '(7 . "standard") ) ) (entmake TextL) ) ;;;程序开始 (setq zmj 0) (initget 5 "") (if (not #ZJWS#)(setq #ZJWS# (getint "\n 输入注记位数<3>：")) ) (if (= #ZJWS# "") (setq #ZJWS# 3)) (initget 7 "") (if (not mjHeight)(setq mjHeight (getreal "\n 输入注记高度<1.5>：")) ) (if (= mjHeight "") (setq mjHeight 1.5)) (setq ss (ssadd)) (while (= 'LIST (type (progn (initget 7 "No") (setq pt1 (getpoint "\n请选择中心点:")) ) ) ) (setq LastEntity (entlast)) (while (progn ;(setq pt1 (getpoint "\n请输入中心点:")) (command "-boundary" pt1 "") (setq LastEntity1 (entlast)) (equal LastEntity LastEntity1) ) (setq pt1 (getpoint "\n请输入中心点:")) ) (command "Area" "o" LastEntity1) ;(entdel (entlast)) ; (ssadd LastEntity1 ss) (setq ss0 (GXL-SEL-ENTNEXTALL LastEntity)) (setq ss (ssaddsel ss0 ss)) (redraw LastEntity1 3) (setq mj (getvar "area")) ;|(if (= mjdw 1000) (setq mj (/ mj 1000000.0)) )|; (princ (rtos mj 2 #ZJWS#)) (setq mj (atof (rtos mj 2 #ZJWS#))) (setq zg mjHeight) (setq zmj (+ zmj mj)) (princ (strcat "当前总面积：" (rtos zmj 2 #ZJWS#))) ;;;注记文字 (gxl-MakeText1 pt1 (rtos mj 2 #ZJWS#) zg 0.8 0 0 ) (ssadd (entlast) ss) ;(setq mj (rtos mj 2 2)) ;(gxl-MakeText pt1 mj zg 0.8 0 0) ) (command "erase" ss "") (princ (strcat "\n 总面积为: " (setq zmj (rtos zmj 2 #ZJWS#)))) (setq zmj (strcat " 总面积为: " zmj)) (setq zg mjHeight) (initget 7 " ") (setq pt2 (getpoint "\n 选择注记位置：")) (if (= 'List (type pt2)) (gxl-MakeText1 pt2 zmj zg 0.8 0 0 ) ) (reerr) ;(princ) )
想送很多鲜花给<font face="Verdana" color="#61b713"><b>Gu_xl</b></font> ，真的很感谢，可以用了！
<p>对你有帮助就好了！</p>
<p>谢谢<font face="Verdana" color="#61b713"><b>Gu_xl</b></font></p>
<p>看见你的</p>
<p>对你有帮助就好了！<img title="明经通道" alt="" src="http://bbs.mjtd.com/images/emot/em311.gif" align="middle" border="0"/></p>
<p>感受不少。</p>
<p>从中又学到了不少东西。</p>
<p>也谢谢明经，让我懂得了不少东西</p>