求多边形面积标注、填充这样的程序

仲文玉

改成框选更好

comechris

请问能批量选择吗？一个一个选择太费劲了

我就是

继续跟帖！太牛了！

群英苍穹

(defun c:test (/ AREA_H AREA_WS ERRHAN NEWENTLAST OBJ OBJ_AREA OBJ_I OBJ_NAME OBJ_VLA OLDCMDECHO OLDDELOBJ OLDENTLAST PT)
(setq obj (ssget  '((0 . "*POLYLINE"))))
(if obj
(progn
(setq obj_i -1)
(setq oldcmdecho (getvar "cmdecho"))
(setq oldDELOBJ (getvar "DELOBJ"))
(setvar "cmdecho" 0);_禁止回显
(setvar "DELOBJ" 0);_控制创建面域保留原对象
(setq errhan '());_不能创建面域的图元句柄表
(setq area_ws 3);_面积的小数位数
(setq area_h 3);_面积文字的高度
(repeat (sslength obj)
(setq obj_name (ssname obj (setq obj_i (1+ obj_i))));_图元名
(setq obj_vla (vlax-ename->vla-object obj_name));_Vla对象
(if (vlax-curve-isClosed obj_vla);_如果曲线闭合
(progn
(setq oldentlast (entlast))
(command "_region" obj_name "");_创建面域
(setq newentlast (entlast))
(if (equal oldentlast newentlast);_如果创建面域不成功
(progn
(setq errhan (cons (cdr (assoc 5 (entget obj_name))) errhan))
)
(progn
(setq obj_area (vla-get-Area obj_vla));_面积
(setq pt (vlax-safearray->list (vlax-variant-value (vla-get-centroid (vlax-ename->vla-object newentlast)))))
(command "-text" "j" "mc" pt area_h 0 (rtos obj_area 2 area_ws))
(entdel newentlast)
)
)
)
)
)
(if errhan
(progn
(princ "\n没有标注面积的图元句柄列表:\n")
(princ errhan)
)
)
(setvar "DELOBJ" oldDELOBJ)
(setvar "cmdecho" oldcmdecho)
)
)
(princ)
)
以上程序是求闭合多段线内面积，哪位高手帮改下，把输出的结果除以25

蓝盾设计

终于找到了，自己想要的资料！