area命令所取得多个对象的面积怎么能标注在图形指定地点
本帖最后由 作者 于 2010-10-7 10:16:00 编辑 <br /><br /> <p></p><p>如图，计算出1、3、5的图形面积之和标注在指定地点</p>
(defun c:mjqh1 (/ pt1 pt2 zg mj zmj ss LastEntity LastEntity1 gxl-Sel-EntNextAll ssaddsel #ZJWS# mjHeight)
;(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)
(setq #ZJWS# (getint "\n输入注记位数："))
(if (not(= 'INT (type #ZJWS#))) (setq #ZJWS# 3))
(setq mjHeight (getreal "\n输入注记高度："))
(if (not(or (= 'INT (type mjHeight))(= 'REAL (type 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)
)
<p>2楼的运行后，出现</p>
<p><font style="BACKGROUND-COLOR: #ffffff" face="Verdana">命令: mjqh1<br/>输入注记位数：<br/>输入注记高度：<br/>请选择中心点:-boundary<br/>指定内部点或 [高级选项(A)]: 正在选择所有对象...<br/>正在选择所有可见对象...<br/>正在分析所选数据...<br/>正在分析内部孤岛...<br/>指定内部点或 [高级选项(A)]:<br/>BOUNDARY 已创建 1 个多段线<br/>命令: Area<br/>指定第一个角点或 [对象(O)/加(A)/减(S)]: o<br/>选择对象:<br/>面积 = 927.8424，周长 = 125.1786<br/>命令: 927.842 当前总面积：927.842; 错误: no function definition: <br/>GXL-NUM-ANGLE->WCS</font></p>
<p>请问要如何操作？望指教。</p>
<p>谢谢</p> <p>怎么执行不了啊？</p> 补上几个自定义函数，看还缺函数么？
;;;==================================================================
;;;gxl-Num-RtoD 弧度转为度数，十进制
;;;==================================================================
(defun gxl-Num-RtoD (dat /)
(* 180.0 (/ dat pi))
)
;;;==================================================================
;;;gxl-Num-DtoR 度数转为弧度，十进制
;;;==================================================================
(defun gxl-Num-DtoR (JD / a)
(setq a (/ (* jd pi) 180.0))
)
;;;获取自定义坐标系的旋转角度函数
(defun gxl-GetUcsRotateAngle ()
(if (= 0 (CAR (GETVAR "UCSXDIR")))
(if (> (CADR (GETVAR "UCSXDIR")) 0) (/ pi 2.0) (/ pi -2.0))
(if (< (CAR (GETVAR "UCSXDIR")) 0)
(+ pi (ATAN (/ (CADR (GETVAR "UCSXDIR")) (CAR (GETVAR "UCSXDIR")))))
(ATAN (/ (CADR (GETVAR "UCSXDIR")) (CAR (GETVAR "UCSXDIR"))))
)
)
)
;;;gxl-Num-Angle->Wcs 角度换算为世界坐标角度，角度单位为度，返回度
(defun gxl-Num-Angle->Wcs (a)
(+ (gxl-Num-RtoD (gxl-GetUcsRotateAngle)) a )
)
<p>5楼的先收下了。</p>
<p>等会试一试。</p>
<p>谢谢<font face="Verdana" color="#61b713"><b>Gu_xl</b></font></p>
<p>国庆快乐</p>
能否修改下面的程序为：拾取一个或多个图形内部点后标注面积之和到指定地点 (defun C:d (/ HOLDCMD HOLDZIN PNT LENT) (vl-load-com) (setq HOLDCMD (getvar "cmdecho")) (setq HOLDZIN (getvar "dimzin")) (setvar "cmdecho" 0) (defun DO_IT () (setvar "dimzin" 0) (setq PNT1 (getpoint "\n点选文字起点: ")) (command "_.text" PNT1 1 ;;这里的1改字高 "" (strcat "" (rtos ENT 2 3);;这里的3改小数位数 ) ) (setvar "dimzin" HOLDZIN) ) (while (if (= PNT NIL) (setq PNT (getpoint "\n点选内部点: ")) PNT ) (setq LENT (entlast)) (command "_.boundary" "a" "i" "y" "" PNT "") (if (not (equal (entlast) LENT)) (progn(setq ENT (vla-get-area (vlax-ename->vla-object (entlast))))(while (not (equal (entlast) LENT)) (entdel (entlast)))(DO_IT) ) ) (setq PNT NIL) ) (setvar "cmdecho" HOLDCMD) (princ) ) <p>能否修改下面的程序为：拾取一个或多个图形内部点后标注面积之和到指定地点 <br/>(defun C:d (/ HOLDCMD HOLDZIN PNT LENT) <br/>(vl-load-com) <br/></p>
<p>我给的程序就是你要的！点取多个图形内部后，按回车键，选择标注的位置，标注完后之前在各个图形内部显示的面积会自动删除！</p> 非常感谢，已经解决了，就是执行到最后是不是有写不顺畅，能否优化一下呢 124350440发表于2010-10-7 16:25:00static/image/common/back.gif非常感谢，已经解决了，就是执行到最后是不是有写不顺畅，能否优化一下呢
<p>怎么不顺畅，说具体点...</p>