找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1255|回复: 6

(完成)[编程申请]:请高手帮小弟编个关于计算面积的小程序

[复制链接]
发表于 2002-12-14 22:19:27 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
我想自动计算图中一些线的面积
已知图中有LAF、LAP和LAY三个图层,每个图层都有若干条多段线。
1)计算所有LAF线面积的总和,并用高度为0.3的文字输入图中,保留一位小数。
2)计算所有LAF和LAP线面积,所有LAY面积的一半,得出的总数用高度为0.3的文字输入图中,保留一位小数。
那位高手肯帮我一定感激万分,谢谢。希望用LISP编写。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 593个

财富等级: 财运亨通

发表于 2002-12-15 10:45:35 | 显示全部楼层

Re: [编程申请]:请高手帮小弟编个关于计算面积的小程序

最初由 箍筋 发布
[B]我想自动计算图中一些线的面积
已知图中有LAF、LAP和LAY三个图层,每个图层都有若干条多段线。
1)计算所有LAF线面积的总和,并用高度为0.3的文字输入图中,保留一位小数。
2)计算所有LAF和... [/B]

工具箱中有个隐含的命令-Plarea,可以计算某一图层上所有封闭多义线的面积和长度,稍微修改可达到你的要求。
有几点你没有说明,层上的线包括哪几类(LWPolyline、Spline、Circle、椭圆?),计算是否包括未封闭曲线、标注单位?

  1. (defun c:plarea (/ getss ss e parea sum_a sum_p)
  2.   (defun getss (str / en ss)
  3.     (if (setq en (car (entsel str)))
  4.       (progn
  5.         (xdrx_setenttodb en)
  6.         (setq ss (ssget "x" (list '(0 . "*polyline") '(70 . 1)
  7.                                   (cons 8 (xdrx_getentdxf 8))
  8.                             )
  9.                  )
  10.         )
  11.       )
  12.       (setq ss (ssget "x" '((0 . "*polyline") (70 . 1))))
  13.     )
  14.     ss
  15.   )
  16.   (setq ss (getss "\n请点取要计算多义线的图层上的实体<忽略层>:"))
  17.   (setq sum_a 0
  18.         sum_p 0
  19.   )
  20.   (xdrx_setsstodb ss 0)
  21.   (while (setq e (xdrx_getentdata 0))
  22.     (setq parea (xdrx_getarea e)
  23.           sum_a (+ sum_a (car parea))
  24.           sum_p (+ sum_p (cadr parea))
  25.     )
  26.   )
  27.   (prompt (strcat "\n多义线面积总和是:" (rtos sum_a 2 2)
  28.                   "\n多义线周长总和是:" (rtos sum_p 2 2)
  29.           )
  30.   )
  31.   (princ)
  32. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2002-12-16 01:52:35 | 显示全部楼层
首先感谢EACHY,现在有点改变我说详细点吧。
我画的是房产证里的宗地平面图,要计算房子的面积,阳台面积双一半。比如有个房子第一二层100平方(画一条线放在LAF图层,这两层的面积就要算两次一共200平方),三至五层面积都是80平方在平面图上重合(画一条线放在LAP图层,面积算三次一共240平方),六层20平方(画一条线放在LAP图层),南面三至五层阳台5平方图上重合(画一条线放在LAY层,总面积5*3/2=7.5平方),北面二层的阳台4平方合(画一条线放在LAY层,总面积4/2=2平方)。现在要算两个数,一个是基底面积(就是LAF的面积,肯定只有一条,是100平方),第二是建筑面积(有些线算一次有些算多于一次,有些算出来还要除以2,一共469.5)
所有线都是封闭的LWPOLYLINE线,不需要周长单位,要把两个结果用高为0.3的文字输入图中
我设想是这样的,不理他的图层,输入命令以后点取LAF和LAP的线,要算两次我就点两次,完成以后回车再点取计算一半的阳台LAY线,完成了回车在屏幕上点一下得出总面积,把基底面积也写出来,你看这样行不行?有时间请帮忙一下,这工作重复率太高了,还要用上计算器很麻烦,谢谢!!

我上传一张图
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 593个

财富等级: 财运亨通

发表于 2002-12-20 13:36:19 | 显示全部楼层
最初由 箍筋 发布
[B]首先感谢EACHY,现在有点改变我说详细点吧。
我画的是房产证里的宗地平面图,要计算房子的面积,阳台面积双一半。比如有个房子第一二层100平方(画一条线放在LAF图层,这两层的面积就要算两次一共200... [/B]

写了个通用些的计算程序,字高你调整下吧。

  1. ;|
  2. 命令: XDTB_Curve_Area1

  3. 功能: 多重计算曲线面积并累加,典型应用房屋面积统计

  4. 说明:1 本程序不检查多义性是否闭合
  5.       2 晓东工具箱环境下运行

  6.   关于该程序的改进建议请到“晓东CAD空间” “开发论坛” 留言
  7.   [url]http://www.xdcad.net/forum[/url]

  8.    By Eachy 12/19/2002
  9. |;
  10. ($xdrx_load "xdlsp.lsp")
  11. (defun c:XDTB_Curve_Area1 (/ ss $area e p num)
  12.   (xdrx_begin)
  13.   (xdrx_sysvar_push "osmode" "dimzin")
  14.   (setvar "dimzin" 0)
  15.   (setq $area 0)
  16.   (while (progn
  17.            (prompt "\n选择统计曲线<结束>.....")
  18.            ;;过滤选择,增加图层选项时格式为
  19.            ;;(setq ss (ssget '((0 . "*Polyline") (8 . "layf"))))
  20.            (setq ss (ssget '((0 . "*Polyline"))))
  21.          )
  22.     (setq num (getreal "\n计算次数<1>: ")) ;实数
  23.     (if        (not num)
  24.       (setq num 1)
  25.     )
  26.     (xdrx_setsstodb ss 0)
  27.     (while (setq e (xdrx_getentdata 0))
  28.       (setq $area (+ $area (* (car (xdrx_getarea e)) num)))
  29.     )
  30.   )
  31.   (if (/= $area 0)
  32.     (progn
  33.       (prompt (strcat "\n总面积 = " (rtos $area 2 2)))
  34.       (setq p (getpoint "\n插入点: "))
  35.       (entmake (list '(0 . "text")
  36.                      '(100 . "AcDbEntity")
  37.                      '(100 . "AcDbText")
  38.                      (cons 10 p)
  39.                      (cons 1 (rtos $area 2 2))
  40.                      '(40 . 3)                ;字体高度可以自定义
  41.                      '(50 . 0)
  42.                )
  43.       )
  44.     )
  45.   )
  46.   (xdrx_sysvar_pop)
  47.   (xdrx_end)
  48.   (princ)
  49. )
  50. ;|
  51. 命令:XDTB_Curve_area2
  52. 功能:自动标注指定图层上拾取范围或者所有多义性面积
  53. |;
  54. (defun c:XDTB_Curve_Area2 (/ lay ss e $area p info)
  55.   (xdrx_begin)
  56.   (xdrx_sysvar_push "osmode" "dimzin")
  57.   (mapcar 'setvar '("dimzin" "osmode") '(0 512))
  58.   (initget 128)
  59.   (setq e (getpoint "\n拾取标注图层实体或输入层名: "))
  60.   (if e
  61.     (progn

  62.       (cond
  63.         ((= (type e) 'STR)
  64.          (setq lay e)
  65.         )
  66.         (T
  67.          (setq ss (xdrx_getptss e 0.1))
  68.          (xdrx_setenttodb (ssname ss 0))
  69.          (setq lay (xdrx_getentdxf 8))
  70.         )
  71.       )
  72.       (setq fillter (list '(0 . "*Polyline")
  73.                           (cons 8 lay)
  74.                     )
  75.       )
  76.       (prompt (strcat "\n所选图层为 " lay))
  77.       (prompt "\n选择标注范围[All - 全选]: ")
  78.       (if (setq ss (ssget fillter))
  79.         (progn
  80.           (xdrx_setsstodb ss 0)
  81.           (while (setq e1 (xdrx_getentdata 0))
  82.             (setq info        (xdrx_curve_info e1)
  83.                   p        (cadr (assoc "Centroid" info))
  84.                   $area        (cadr (assoc "Area" info))
  85.             )
  86.             (entmake (list '(0 . "text")
  87.                            '(100 . "AcDbEntity")
  88.                            '(100 . "AcDbText")
  89.                            (cons 10 (append p '(0)))
  90.                            (cons 1 (rtos $area 2 2))
  91.                            '(40 . 3)        ;字体高度可以自定义
  92.                            '(50 . 0)
  93.                      )
  94.             )
  95.             (xdrx_group_make "*" (entlast) e1)
  96.           )
  97.         )
  98.       )
  99.     )
  100.   )
  101.   (xdrx_sysvar_pop)
  102.   (xdrx_end)
  103.   (princ)
  104. )

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2002-12-21 12:58:22 | 显示全部楼层
非常感谢eachy!!这程序很好用,原来计算阳台的时候输入小数就可以了。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2005-9-5 17:14:32 | 显示全部楼层
是不是不装晓东工具箱就不能用的啊!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2009-7-16 20:22:34 | 显示全部楼层
这么好的lisp一定要支持的。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-3-28 23:34 , Processed in 0.548234 second(s), 44 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表