提取大量闭合PL线的面积属性并写入图形中心(已解决)

zxjing

恳请斑竹大人帮忙撒

已知,在CAD特性面板中有面积属性,

需要程序提取大量闭合PL线的  面积属性,并置于该图形中心(形心,中心,重心,什么心都可以)

卖软件的免进~谢

npcer

gufeng 发表于 2010-8-10 23:31
估计你使用的是2楼的代码 使用11楼的代码应该没问题
错误: no function definition: VLAX-ENAME->VLA-OB ...

2楼和11楼的代码有什么区别啊，看了下11楼的账号被封了，我现在用2楼的是正常的，11楼那个代码能方便贴出来对比一下吗，谢谢

bingxiaoying

菜鸟想要问一问  启动的命令是啥啊

gufeng

2. (defun c:test (/ AREA_H AREA_WS ERRHAN NEWENTLAST OBJ OBJ_AREA OBJ_I OBJ_NAME OBJ_VLA OLDCMDECHO OLDDELOBJ OLDENTLAST PT)
3.   (setq obj (ssget "x" '((0 . "*POLYLINE"))))
4.   (if obj
5.     (progn
6.       (setq obj_i -1)
7.       (setq oldcmdecho (getvar "cmdecho"))
8.       (setq oldDELOBJ (getvar "DELOBJ"))
9.       (setvar "cmdecho" 0);_禁止回显
10.       (setvar "DELOBJ" 0);_控制创建面域保留原对象
11.       (setq errhan '());_不能创建面域的图元句柄表
12.       (setq area_ws 3);_面积的小数位数
13.       (setq area_h 3);_面积文字的高度
14.       (repeat (sslength obj)
15. (setq obj_name (ssname obj (setq obj_i (1+ obj_i))));_图元名
16. (setq obj_vla (vlax-ename->vla-object obj_name));_Vla对象
17. (if (vlax-curve-isClosed obj_vla);_如果曲线闭合
18.    (progn
19.      (setq oldentlast (entlast))
20.      (command "_region" obj_name "");_创建面域
21.      (setq newentlast (entlast))
22.      (if (equal oldentlast newentlast);_如果创建面域不成功
23.        (progn
24.   (setq errhan (cons (cdr (assoc 5 (entget obj_name))) errhan))
25.   )
26.        (progn
27.   (setq obj_area (vla-get-Area obj_vla));_面积
28.   (setq pt (vlax-safearray->list (vlax-variant-value (vla-get-centroid (vlax-ename->vla-object newentlast)))))
29.   (command "-text" "j" "mc" pt area_h 0 (rtos obj_area 2 area_ws))
30.   (entdel newentlast)
31.   )
32.        )
33.      )
34.    )
35. )
36.       (if errhan
37. (progn
38. (princ "\n没有标注面积的图元句柄列表:\n")
39. (princ errhan)
40. )
41. )
42.       (setvar "DELOBJ" oldDELOBJ)
43.       (setvar "cmdecho" oldcmdecho)
44.     )
45.   )
46.   (princ)
47. )

(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 "x" '((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) )

zxjing

谢谢热心大侠,试加载了一下,出现如上错误,恳请大侠再度出手,小弟不胜感激~

ZZXXQQ

程序开头加一句：(vl-load-com)

zxjing

谢过版主大人,明天测试

zxjing

gufeng,谢谢你,还有版主大人

xd-xdcad

这个程序非常好i，若是能够先选择对象，然后仅仅标注已选择的对象的面积就好了

从而实现选择对象，然后自动标注面积

Gu_xl

xd-xdcad发表于2010-7-19 12:00:00这个程序非常好i，若是能够先选择对象，然后仅仅标注已选择的对象的面积就好了 从而实现选择对象，然后自动标注面积

把 (setq obj (ssget "x" '((0 . "*POLYLINE")))) 改为 (setq obj (ssget  '((0 . "*POLYLINE")))) 即可！

xd-xdcad

谢谢Gu_xl

实验成功，但又发现了一个小问题，不知是否方便将得到的结果除以10的6次方，其他与原先一致？

例如原先的面积单位是平方毫米，现在改为平方米？

在上面这个程序对没有使用闭合命令的PL线不起作用，不知是否方便更改？

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=63167&replyID=&skin=0

在上面链接中，ZZXXQQ版主提供了一个非常好程序，没有使用闭合命令C的PL线面积也能够计算出来，遗憾的是一次仅仅能够计算一个图形面积，若能同时选择多个图形并分别计算面积就好了？并且ZZXXQQ版主的程序也存在面积单位的问题，与我想象的程序不一致，不知能否将两个程序的优点结合在一起？