框选 图形上的所有闭合的 《修订云线》 算出所有闭合的云线面积 ，并写在上面

zzmm

    怎样用lisp计算云线的面域
还请各位版主帮帮忙 主要是云线的算法
地一步 框选图形中的 《修订云线》
地二步 计算每个修订云线内的面积

地三步 写出每个闭合云线的面域
地四步 计算出总面域

xiabin68

这种线我都重来没有用过呢？

zzmm

我看到 gufeng  大哥写的一段代码 是计算 圆 弧 椭圆 轻型多段线 多段线 面域 或封闭样条曲线构成的封闭面积计算 能算出 修订云线的面积
可是 VL函数有点看不懂 如果我想在里面添加如 图2 所制定出的  应该怎么修改 麻烦各位牛人 好心的版主解决一下  谢谢

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

(defun c:testb (/ AREA_H AREA_WS ERRHAN NEWENTLAST OBJ OBJ_AREA OBJ_I OBJ_NAME OBJ_VLA OLDCMDECHO OLDDELOBJ OLDENTLAST PT)<br /> （vl-load-com)<br />   (setq obj (ssget "x" '((0 . "LWPOLYLINE"))))<br />   (if obj<br />     (progn<br />       (setq obj_i -1)<br />       (setq oldcmdecho (getvar "cmdecho"))<br />       (setq oldDELOBJ (getvar "DELOBJ"))<br />       (setvar "cmdecho" 0);_禁止回显<br />       (setvar "DELOBJ" 0);_控制创建面域保留原对象<br />       (setq errhan '());_不能创建面域的图元句柄表<br />       (setq area_ws 4);_面积的小数位数<br />       (setq area_h 3);_面积文字的高度<br />       (repeat (sslength obj)<br /> (setq obj_name (ssname obj (setq obj_i (1+ obj_i))));_图元名<br /> (setq obj_vla (vlax-ename->vla-object obj_name));_Vla对象<br /> (if (vlax-curve-isClosed obj_vla);_如果曲线闭合<br />    (progn<br />      (setq oldentlast (entlast))<br />      (command "_region" obj_name "");_创建面域<br />      (setq newentlast (entlast))<br />      (if (equal oldentlast newentlast);_如果创建面域不成功<br />        (progn<br />   (setq errhan (cons (cdr (assoc 5 (entget obj_name))) errhan))<br />   )<br />        (progn<br />   (setq obj_area (vla-get-Area obj_vla));_面积<br />   (setq pt (vlax-safearray->list (vlax-variant-value (vla-get-centroid (vlax-ename->vla-object newentlast)))))<br />   (command "-text" "j" "mc" pt area_h 0 (rtos obj_area 2 area_ws))<br />   (entdel newentlast)<br />   )<br />        )<br />      )<br />    )<br /> )<br />       (if errhan<br /> (progn<br /> (princ "\n没有标注面积的图元句柄列表:\n")<br /> (princ errhan)<br /> )<br /> )<br />       (setvar "DELOBJ" oldDELOBJ)<br />       (setvar "cmdecho" oldcmdecho)<br />     )<br />   )<br />   (princ)<br /> )

zzmm

zzmm 发表于 2012-12-10 17:39
我看到 gufeng  大哥写的一段代码 是计算 圆 弧 椭圆 轻型多段线 多段线 面域 或封闭样条曲线构成的封闭面积 ...

这行代码是用的 gufeng 老大的 借用一下你的源码 谢谢

love12314

路过帮顶

haoryh

路过也帮忙顶一下！

ZZXXQQ

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0

江豚大大

看不懂啊 看不懂~~~

zzmm

非常感谢 ZZXXQQ 版主的热心帮助与回复
今天运行程序时发现以下几点问题
1 计算面积的表 如果在捕捉状态会重叠在一起
  以改 在程序前面添加 （setvar "osmode" 0）
2 如果计算面域非常大 以百万左右来表达 那选得总表的字体太小
  以改 （setq h 3）
  改写为
  (setq txth (getreal "\n指定文字高度 <500>:"))
     (if (or (= txth nil) (= txth 0))
       (setq txth 500)
     )
3 不会改的地方是
  面积 0~n=??????  0 1 2 3 ~n改为横线上方 =去掉 面积改在横线下方  表格不改动
     还希望版主能帮忙解决一下
  在这表示衷心的感谢