（测试）[公告]：准备写一些关于各种面积统计的程序。

eachy · 发表于 2003-8-27 21:36:38

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

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

×

准备在工具箱中增加各种统计面积的程序（当然也可以是其他的统计），任何专业的都可以。

欢迎你的建议。

hs_f · 发表于 2003-8-27 22:37:07

填充面积好象就够用了，能将结果返回到绘图区标注最好。
还有什么需要统计面积呢？
什么时候出for 2004？很关心哦。

eachy · 发表于 2003-8-27 23:19:19

最初由 hs_f 发布
[B]填充面积好象就够用了，能将结果返回到绘图区标注最好。
还有什么需要统计面积呢？
什么时候出for 2004？很关心哦。 [/B]

有的统计可能希望标注，有的希望输出表格等等。。

hs_f · 发表于 2003-8-27 23:31:07

1、控规地块面积计算；
2、总规用地平衡表；
3、。。。。
－－－有关工具箱的2004版本，无可奉告？商业机密？就是不告诉你？。。。

陌生人 · 发表于 2003-8-28 01:23:01

工具箱是用2002的arx编写.不能通用于2004,原程序要从新编写或修改.

xiaofang08 · 发表于 2003-8-28 08:50:55

1\要求统计出同一图层的线段长度和,可用于电线长度计算
2\要求统计出同一图块的个数
3\要求统计出相同填充的面积和
4\要求用EXCLE出报表

bluejan · 发表于 2003-8-28 15:52:34

统计面积或者长度在预决算里面用的很多，要是有这样的程序那就方便多了

xiaofang08 · 发表于 2003-8-29 12:19:10

最初由 bluejan 发布
[B]统计面积或者长度在预决算里面用的很多，要是有这样的程序那就方便多了 [/B]

我说的就是用在预决算里面的。

陌生人 · 发表于 2003-8-29 21:40:44

统计建筑使用面积，建筑面积。列表

寒梅 · 发表于 2003-8-29 22:46:52

如图

xianxl · 发表于 2003-8-31 02:26:21

其实相减的命令ACAD的ARAE里就有，就是用起来不方便，能不能写个更方便使用的就太好了！因为算建筑面积确实经常用到要相减的时候。

yl4116 · 发表于 2003-9-2 09:47:39

希望对大家有用！

xiaofang08 · 发表于 2003-9-4 18:45:55

还没开始做吗，我有些急了我天天在盼O，完成了我要第一个试用呵呵

lbf760913 · 发表于 2003-9-4 20:49:59

*-*3 在道路设计中有每隔20米就一个横断面图，需要计算出填挖方量，由于实际工程中往往有挖有填的，如果道路长度有10公里，用CAD中自带的量取面积命令好象很劳神，尤其在市政道路中如此，不知有哪位学长有这方面的程序？

eachy · 发表于 2003-9-6 08:14:39

;|
功能：计算封闭曲线（*polyline,spline,circle,ellipse)面积并标注
说明：用于统计曲线面积，包括三种方式：
1. boundary方式，拾取点，如果生成边界则标面积
2. 统计图层曲线面积
3. 选择范围后标注所有曲线积
程序中标注数字采用了临时图层tmp_area，方便使用
需配合xdrx_api build 11208以上版本使用。
|;
($xdrx_load "xdlsp.lsp")
(defun c:XDTB_PlIsOff (/ ss e n)
(setq ss (ssget '((0 . "*polyline"))))
(if ss
(progn
(setq n 0)
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(if (not (xdrx_curve_isclosed e))
(progn
(redraw e 3)
(setq n (1+ n))
)
)
)
(princ (strcat "\n共检查 " (itoa (sslength ss)) " 根多义线. ")
(if (zerop n)
"全部闭合. "
(strcat "共 " (itoa n) " 根非闭合多义线!")
)
)
)
)
(princ)
)
(defun c:XDTB_AREA0
(/ kw redraw_le get_area get_layer_area get_point_area)
(defun redraw_le ()
(foreach e le_drw (redraw e 4))
(foreach e le_del (entdel e))
(setq le_drw nil
le_del nil
)
)
(defun get_area (l / _area ss ss0 ss1 e e1 info pt str len)
(setq ss1 (ssadd)
_area 0.0
)
(princ
"\n选择拾取范围 (*polyline,circle,ellipse,spline)<全选>: "
)
(setq ss (ssget "x" l))
(setq ss0 (ssget l)
ss (if ss0
ss0
ss
)
)
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(setq info (xdrx_curve_info e))
(setq pt (xdrx_midp (cadr (last info)) (caddr (last info))))
(if (xdrx_curve_isclosed e)
(progn
(if (not (xdrx_getxdata e "面积"))
(progn
(setq str (rtos (/ (cadr (assoc "Area" info)) 1e6) 2 2))
(if (not (setq str (xdrx_getxdata e "面积")))
(progn (setq
str (rtos (/ (cadr (assoc "Area" info)) 1e6) 2 2)
)
(xdrx_setxdata e "面积" str)
)
(setq str (car (xdrx_getxdata e "面积")))
)
)
(setq str (car (xdrx_getxdata e "面积")))
)
(setq _area (+ _area (read str)))
(command ".text" "j" "mc" pt (* 3 bl) 0 str)
)
(setq ss1 (ssadd e ss1))
)
)
(princ (strcat "\n\t总面积为 " (rtos _area 2 2) "。"))
(if (/= (sslength ss1) 0)
(progn (If (And (Zerop (Getvar "cmdactive")) (Ssget "i"))
(sssetfirst nil)
)
(xdrx_setsstodb ss1 0)
(while (setq e1 (xdrx_getentdata 0))
(redraw e1 3)
(setq le_drw (cons e1 le_drw))
)
(redraw_le)
(sssetfirst nil ss1)
(setq len (rtos (sslength ss1) 2 0))
(prompt
(strcat "\n\t" "共 " len " 根非闭合多义线未标注面积。")
)
)
)
)
(defun get_layer_area (/ e)
(setq e (xdrx_entsel "\n拾取实体: "))
(princ (strcat "\n你已选择了 " (xdrx_getentdxf 8) " 层"))
(get_area
(list '(0 . "*polyline,circle,ellipse,spline")
(cons 8 (xdrx_getentdxf 8))
)
)
)
(defun get_point_area (/ p0 e str info tf)
(setq p0 (getpoint "\n拾取标注范围内一点: "))
(while p0
(if (setq e (bpoly p0))
(progn (setq info (xdrx_getarea e))
(entdel (entlast))
(setq str (rtos (/ (car info) 1e6) 2 2))
(command ".text" "j" "mc" p0 (* 3 bl) 0 str)
)
(progn (xdrx_drawing_viewsave)
(command ".zoom" ".3x")
(setq tf T)
(alert "无法找到范围, 重新选择！")
)
)
(setq p0 (getpoint "\n拾取标注范围内一点: "))
)
(if tf
(xdrx_drawing_viewres)
)
)
(xdrx_begin "tmp_area" "1")
(xdrx_sysvar_push "cmdecho")
(setvar "cmdecho" 0)
(xdrx_ucson)
(initget "1 2 3")
(setq kw (getkword "\n[1 拾取点/2 按图层/3 选择范围]<3>: "))
(cond ((eq kw "1") (get_point_area))
((eq kw "2") (get_layer_area))
(T (get_area '((0 . "*polyline,circle,ellipse,spline"))))
)
(xdrx_ucsoff)
(xdrx_end)
(xdrx_sysvar_pop)
(princ)
)
(defun c:xdtb_ptarea (/ pt pts area e)
(while (setq pt (getpoint "\nPoint: "))
(if (= (type pt) 'LIST)
(setq pts (cons pt pts))
)
)
(if pts
(progn
(xdrx_begin)
(xdrx_sysvar_push "osmode" "dimzin")
(setvar "dimzin" 0)
(setq area (abs (apply 'xdrx_parea pts)))
(setq e (xdrx_entsel "\n拾取标注文字: " '((0 . "text"))))
(xdrx_setenttodb (car e))
(xdrx_setxdata "area" (rtos area 2 1))
(princ (strcat "\nArea = " (rtos area 2 1)))
(xdrx_sysvar_pop)
(xdrx_end)
)
)
(princ)
)
(defun c:xdtb_tjarea (/ e ss lay str area pt)
(setq e (xdrx_entsel "\n拾取典型文字: " '((-3 ("AREA")))))
(if e
(progn
(xdrx_begin)
(xdrx_sysvar_push "osmode")
(setvar "osmode" 0)
(xdrx_setenttodb (car e))
(setq lay (xdrx_getentdxf 8))
(princ "\n拾取统计范围(回车全选)...")
(if (not (setq ss (ssget (list (cons 8 lay) '(-3 ("area"))))))
(setq ss
(ssget "x" (list (cons 8 lay) '(-3 ("area"))))
)
)
(if ss
(progn
(setq pt (getpoint "\n输出点: "))
(xdrx_setsstodb ss 0)
(while (setq e1 (xdrx_getentdata 0))
(setq str (xdrx_getentdxf 1)
area (car (xdrx_getxdata e1 "area"))
)
(vl-cmdf ".text" pt 1.6 "0" (strcat str " " area))
(setq pt (polar pt (- _pi2) 6.))
)
)
)
(xdrx_sysvar_pop)
(xdrx_end)
(princ)
)
)
)

;| 
功能：计算封闭曲线（*polyline,spline,circle,ellipse)面积并标注 
 
说明：用于统计曲线面积，包括三种方式： 
      1. boundary方式，拾取点，如果生成边界则标面积 
      2. 统计图层曲线面积 
      3. 选择范围后标注所有曲线积    
 
      程序中标注数字采用了临时图层tmp_area，方便使用 
 
      需配合xdrx_api build 11208以上版本使用。 
|; 
($xdrx_load "xdlsp.lsp") 
(defun c:XDTB_PlIsOff (/ ss e n) 
  (setq ss (ssget '((0 . "*polyline")))) 
  (if ss 
    (progn 
      (setq n 0) 
      (xdrx_setsstodb ss 0) 
      (while (setq e (xdrx_getentdata 0)) 
        (if (not (xdrx_curve_isclosed e)) 
          (progn 
            (redraw e 3) 
            (setq n (1+ n)) 
          ) 
        ) 
      ) 
      (princ (strcat "\n共检查 " (itoa (sslength ss)) " 根多义线. ") 
             (if (zerop n) 
               "全部闭合. " 
               (strcat "共 " (itoa n) " 根非闭合多义线!") 
             ) 
      ) 
    ) 
  ) 
  (princ) 
)    
(defun c:XDTB_AREA0 
       (/ kw redraw_le get_area get_layer_area get_point_area) 
  (defun redraw_le () 
    (foreach e le_drw (redraw e 4)) 
    (foreach e le_del (entdel e)) 
    (setq le_drw nil 
          le_del nil 
    ) 
  ) 
  (defun get_area (l / _area ss ss0 ss1 e e1 info pt str len) 
    (setq ss1        (ssadd) 
          _area        0.0 
    ) 
    (princ 
      "\n选择拾取范围 (*polyline,circle,ellipse,spline)<全选>: " 
    ) 
    (setq ss (ssget "x" l)) 
    (setq ss0 (ssget l) 
          ss  (if ss0 
                ss0 
                ss 
              ) 
    ) 
    (xdrx_setsstodb ss 0) 
    (while (setq e (xdrx_getentdata 0)) 
      (setq info (xdrx_curve_info e)) 
      (setq pt (xdrx_midp (cadr (last info)) (caddr (last info)))) 
      (if (xdrx_curve_isclosed e) 
        (progn 
          (if (not (xdrx_getxdata e "面积")) 
            (progn 
              (setq str (rtos (/ (cadr (assoc "Area" info)) 1e6) 2 2)) 
              (if (not (setq str (xdrx_getxdata e "面积"))) 
                (progn (setq 
                         str (rtos (/ (cadr (assoc "Area" info)) 1e6) 2 2) 
                       ) 
                       (xdrx_setxdata e "面积" str) 
                ) 
                (setq str (car (xdrx_getxdata e "面积"))) 
              ) 
            ) 
            (setq str (car (xdrx_getxdata e "面积"))) 
          ) 
          (setq _area (+ _area (read str))) 
          (command ".text" "j" "mc" pt (* 3 bl) 0 str) 
        ) 
        (setq ss1 (ssadd e ss1)) 
      ) 
    ) 
    (princ (strcat "\n\t总面积为 " (rtos _area 2 2) "。")) 
    (if        (/= (sslength ss1) 0) 
      (progn (If (And (Zerop (Getvar "cmdactive")) (Ssget "i")) 
               (sssetfirst nil) 
             ) 
             (xdrx_setsstodb ss1 0) 
             (while (setq e1 (xdrx_getentdata 0)) 
               (redraw e1 3) 
               (setq le_drw (cons e1 le_drw)) 
             ) 
             (redraw_le) 
             (sssetfirst nil ss1) 
             (setq len (rtos (sslength ss1) 2 0)) 
             (prompt 
               (strcat "\n\t" "共 " len " 根非闭合多义线未标注面积。") 
             ) 
      ) 
    ) 
  ) 
  (defun get_layer_area        (/ e) 
    (setq e (xdrx_entsel "\n拾取实体: ")) 
    (princ (strcat "\n你已选择了 " (xdrx_getentdxf 8) " 层")) 
    (get_area 
      (list '(0 . "*polyline,circle,ellipse,spline") 
            (cons 8 (xdrx_getentdxf 8)) 
      ) 
    ) 
  ) 
  (defun get_point_area        (/ p0 e str info tf) 
    (setq p0 (getpoint "\n拾取标注范围内一点: ")) 
    (while p0 
      (if (setq e (bpoly p0)) 
        (progn (setq info (xdrx_getarea e)) 
               (entdel (entlast)) 
               (setq str (rtos (/ (car info) 1e6) 2 2)) 
               (command ".text" "j" "mc" p0 (* 3 bl) 0 str) 
        ) 
        (progn (xdrx_drawing_viewsave) 
               (command ".zoom" ".3x") 
               (setq tf T) 
               (alert "无法找到范围, 重新选择！") 
        ) 
      ) 
      (setq p0 (getpoint "\n拾取标注范围内一点: ")) 
    ) 
    (if        tf 
      (xdrx_drawing_viewres) 
    ) 
  ) 
  (xdrx_begin "tmp_area" "1") 
  (xdrx_sysvar_push "cmdecho") 
  (setvar "cmdecho" 0) 
  (xdrx_ucson) 
  (initget "1 2 3") 
  (setq kw (getkword "\n[1 拾取点/2 按图层/3 选择范围]<3>: ")) 
  (cond        ((eq kw "1") (get_point_area)) 
        ((eq kw "2") (get_layer_area)) 
        (T (get_area '((0 . "*polyline,circle,ellipse,spline")))) 
  ) 
  (xdrx_ucsoff) 
  (xdrx_end) 
  (xdrx_sysvar_pop) 
  (princ) 
) 
 
(defun c:xdtb_ptarea (/ pt pts area e) 
  (while (setq pt (getpoint "\nPoint: ")) 
    (if        (= (type pt) 'LIST) 
      (setq pts (cons pt pts)) 
    ) 
  ) 
  (if pts 
    (progn 
      (xdrx_begin) 
      (xdrx_sysvar_push "osmode" "dimzin") 
      (setvar "dimzin" 0) 
      (setq area (abs (apply 'xdrx_parea pts))) 
      (setq e (xdrx_entsel "\n拾取标注文字: " '((0 . "text")))) 
      (xdrx_setenttodb (car e)) 
      (xdrx_setxdata "area" (rtos area 2 1)) 
      (princ (strcat "\nArea = " (rtos area 2 1))) 
      (xdrx_sysvar_pop) 
      (xdrx_end) 
    ) 
  ) 
  (princ) 
) 
(defun c:xdtb_tjarea (/ e ss lay str area pt) 
  (setq e (xdrx_entsel "\n拾取典型文字: " '((-3 ("AREA"))))) 
  (if e 
    (progn 
      (xdrx_begin) 
      (xdrx_sysvar_push "osmode") 
      (setvar "osmode" 0) 
      (xdrx_setenttodb (car e)) 
      (setq lay (xdrx_getentdxf 8)) 
      (princ "\n拾取统计范围(回车全选)...") 
      (if (not (setq ss (ssget (list (cons 8 lay) '(-3 ("area")))))) 
        (setq ss 
               (ssget "x" (list (cons 8 lay) '(-3 ("area")))) 
        ) 
      ) 
      (if ss 
        (progn 
          (setq pt (getpoint "\n输出点: ")) 
          (xdrx_setsstodb ss 0) 
          (while (setq e1 (xdrx_getentdata 0)) 
            (setq str  (xdrx_getentdxf 1) 
                  area (car (xdrx_getxdata e1 "area")) 
            ) 
            (vl-cmdf ".text" pt 1.6 "0" (strcat str "    " area)) 
            (setq pt (polar pt (- _pi2) 6.)) 
          ) 
        ) 
      ) 
      (xdrx_sysvar_pop) 
      (xdrx_end) 
      (princ) 
    ) 
  ) 
)

账号		自动登录	找回密码
密码			立即注册

（测试）[公告]：准备写一些关于各种面积统计的程序。

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

相关帖子

希望对大家有用！

关于面积的程序

浏览过的版块