明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 4572|回复: 7

[求助]求助算面积程序?

[复制链接]
发表于 2003-7-8 11:41 | 显示全部楼层 |阅读模式
各位老师,我想用ARX编一个标注面积的程序,对于任意多边形,只需点击即可标出面积,可否帮忙?我这里先谢谢了。我的信箱lihongyu2467@163.com
发表于 2003-7-8 12:30 | 显示全部楼层
你要明确一点:你所说的任意多边形?是否包括各条边可以交叉的凹多边形?
另外,点击即可标出面积,该多边形在图形中已经存在,对吗?
 楼主| 发表于 2003-7-8 23:28 | 显示全部楼层
再详细一点,就是说多边形已经在图形中画出,可以是多边形,或者是圆等等的集合,当然包括各条边可以交叉的凹多边形,也就是用pline线随意画一些交叉的闭合图形。
发表于 2003-7-8 23:50 | 显示全部楼层
有vba写的面积计算程序,要不?
发表于 2003-7-21 13:25 | 显示全部楼层
与其自己写一个边界搜索算法,不如直接使用boundary命令
发表于 2003-7-27 09:44 | 显示全部楼层
;;;面积标注 hwt
(defun c:TP (/ k)
                                        ;(alert "\n请确定所要查询的区域是否闭合,否则结果会出错!")
  (command "layer" "set" "TP" "")
  (initget "Yes No")
  (setq        k
         (getkword
           "\n请选择:[Yes]在图上标注面积 [No]仅查寻面积(不标注)[Y / N]/<Y>:"
         )
  )

  (cond
    ((= k "Yes") (ISCLOSE))
    ((= k "No") (ubzmj))
    (T (ISCLOSE))
  )
)


;;;判断区域是否闭合,然后创建面域
(defun ISCLOSE (/ pt os mj m zc table ent1 entnm1 entnm2)
  (setq table (entget (entlast)))
  (setq entnm1 (assoc -1 table))
  (setq entnm1 (cdr entnm1))
  (setq pt1 (getpoint "请在区域内任意一点")) ;取一点创建面域
  (command "bpoly" pt1 "")                ;创建面域   
  (setq ent1 (entlast))
  (setq table (entget ent1))
  (setq entnm2 (assoc -1 table))
  (setq entnm2 (cdr entnm2))
  (if (equal entnm1 entnm2)                ;非T,区域没有闭合
    ((alert "区域没有封闭,无法进行面积计算,请检查!") ())
                                        ;如果已经闭合则执行以下程序
    (bzmj)
  )
)

;;;面积标注
(defun bzmj (/              TXTSIZE  HEADTXT        PRECISION          OLDCMD
             SEL      ENT      ENTLIST        ENTNAME         VLAENT          AREA
             PT              REGENT
            )
  (vl-load-com)
  (setq TXTSIZE 2.5)
  (setq HEADTXT "")
  (setq PRECISION 3)

                                        ;(setq SEL t)
                                        ;(entdel (entlast))
                                        ;(while SEL
  (setq ENT (entsel "\n选取封闭多义线/面域: "))
  (if ENT
    (progn
      (setq ENTLIST (entget (car ENT)))
      (setq ENTNAME (strcase (cdr (assoc 0 ENTLIST))))
      (cond
        ((and (wcmatch ENTNAME "*POLYLINE") ;对象多义线
              (setq VLAENT (vlax-ename->vla-object (car ENT)))
              (= :vlax-true (vla-get-closed VLAENT))
         )
         (setq AREA
                (strcat        HEADTXT
                        (rtos (vlax-curve-getarea VLAENT) 2 PRECISION)
                )
         )
         (command "_.copy" (car ENT) "" "0,0" "0,0")
         (command "region" (car ENT) "")
         (setq REGENT (entlast))
         (setq
           PT (vlax-get (vlax-ename->vla-object REGENT) "centroid")
         )
         (entdel REGENT)
         (command "layer" "set" "ZJ" "")
         (command "text" "j" "c" PT TXTSIZE "" AREA)
        )
        ((= ENTNAME "REGION")                ;对象为面域
         (command "area" "o" (car ENT))
         (setq
           AREA        (strcat HEADTXT (rtos (getvar "area") 2 PRECISION))
         )
         (setq REGENT (car ENT))
         (setq
           PT (vlax-get (vlax-ename->vla-object REGENT) "centroid")
         )
         (entdel (entlast))
         (command "layer" "set" "ZJ" "")
         (command "text" "j" "c" PT TXTSIZE "" AREA)
         (ALERT "\n对象为面域")
        )
        (t (alert "\n你所选择的对象非封闭多义线!!"))

      )
    )
                                        ;(setq SEL NIL)
  )
                                        ;)

  (princ)
)


;;;选择标注的单位
(defun xzdw (/ dw bzdw)
  (initget " 1 2 3 ")
  (setq
    dw (getkword
         "\n请选择标注的单位1)平方米/(2)亩/(3)公顷/<1>:"
       )
  )
  (cond
    ((= dw "1") (setq bzdw "平方米"))
    ((= dw "2") (setq bzdw "亩"))
    ((= dw "3") (setq bzdw "公顷"))
    (t (setq bzdw "平方米"))
  )
)



;;;查询面积的程序,不标注
(defun ubzmj (/ pt os mj m zc table ent entnm1 entnm2)
  (setq table (entget (entlast)))
  (setq entnm1 (assoc -1 table))
  (setq entnm1 (cdr entnm1))
  (setq pt (getpoint "请在区域内任意一点"))
  (command "bpoly" pt "")
  (setq ent (entlast))
  (setq table (entget ent))
  (setq entnm2 (assoc -1 table))
  (setq entnm2 (cdr entnm2))
  (if (equal entnm1 entnm2)                ;非T,区域没有闭合
    (alert "区域没有封闭,无法进行面积计算,请检查!") ;end yes
    (progn
      (command "area" "o" ent)
      (entdel ent)
      (setq mj (getvar "area"))
      (setq m (/ mj 666.667))
      (setq zc (getvar "perimeter"))
      (setq MJ (rtos MJ))
      (setq m (rtos m))
      (setq ZC (rtos ZC))
      (setq str        (strcat        "地块面积="  MJ                  "(平方米) = "
                        m             "(亩)"          "\n区域周长="
                        ZC
                       )
      )
      (alert str)
      (princ "\n地块面积(平方米) = ")
      (princ mj)
      (princ "\t折合为(亩) = ")
      (princ m)
      (princ "\t区域周长=")
      (princ zc)
    )                                        ;END PROGN
  )                                        ;END IF

  (princ)
)

评分

参与人数 1威望 +1 金钱 +5 贡献 +1 激情 +5 收起 理由
mccad + 1 + 5 + 1 + 5 【好评】好文章好程序

查看全部评分

 楼主| 发表于 2003-7-27 12:31 | 显示全部楼层
非常感谢tjztsh的解答,希望日后继续指教。不知有无ARX 编写的,那就在好不过了。
发表于 2011-6-26 03:09 | 显示全部楼层
谢谢了 下载了
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 16:43 , Processed in 0.189979 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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