找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 760|回复: 6

[每日一码] 多义线的面积计算和输出

[复制链接]

已领礼包: 568个

财富等级: 财运亨通

发表于 2018-5-10 07:10:47 | 显示全部楼层 |阅读模式

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

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

×
本帖最后由 newer 于 2018-5-10 08:56 编辑

  1. (princ "\n面积输出程序,作者:王永高......")
  2. (princ
  3.   "\n在命令行输入mj进行多义线的面积计算和输出,输出到d:/mj.txt文件里......"
  4. )
  5. (defun c:mj ()
  6.   (setq os (getvar "osmode")
  7.         om (getvar "cmdecho")
  8.   )
  9.   (setvar "osmode" 0)
  10.   (setvar "cmdecho" 0)
  11.   (setq AcadObject   (vlax-get-acad-object)
  12.         AcadDocument (vla-get-ActiveDocument AcadObject)
  13.         mSpace       (vla-get-ModelSpace AcadDocument)
  14.   )
  15.   (princ "\n请选择物体:")
  16.   (setq file1 (open "d:/mj.txt" "w"))
  17.   (vl-load-com)
  18.   (setq ss1 (ssget)
  19.         i   0
  20.   )
  21.   (setq currCenterPnt (vlax-make-safearray vlax-vbDouble '(0 . 2)))
  22.   (if ss1
  23.     (progn
  24.       (repeat (sslength ss1)
  25.         (setq ss11 (ssname ss1 i))
  26.         (setq ss11ent (entget ss11))
  27.         (setq ss11-name (cdr (assoc 0 ss11ent)))
  28.         (setq ss12 (vlax-ename->vla-object ss11))
  29.         (setq mj1 (vlax-curve-getArea ss12))
  30.         (cond ((= ss11-name "ELLIPSE")
  31.                (setq currCenterPnt (vla-get-center ss12))
  32.               )
  33.               ((= ss11-name "CIRCLE")
  34.                (setq currCenterPnt (vla-get-center ss12))
  35.               )
  36.               ((= ss11-name "LWPOLYLINE")
  37.                (setq currCenterPnt (zhongxin ss11))
  38.               )
  39.               ((= ss11-name "POLYLINE")
  40.                (setq currCenterPnt (zhongxin ss11))
  41.               )
  42.               (T (princ "\n选择的物体没有面积."))
  43.         )
  44. ;;;        (setq length1(vla-get-length ss12 ))
  45.         (princ (+ i 1) file1)
  46.         (princ "\t" file1)
  47.         (princ mj1 file1)
  48.         (princ "\n" file1)
  49. ;;;        (setq currCenterPnt (vla-get-center ss12))
  50.         (setq TextObj (vla-AddText
  51.                         mSpace
  52.                         (strcat "No:" (itoa (+ i 1)) "  " (rtos mj1 2 2) "平方米.")
  53.                         currCenterPnt
  54.                         6
  55.                       )
  56.         )
  57. ;;;        (vla-ZoomExtents AcadObject)
  58.         (setq i (+ i 1))
  59.         (princ "\n")
  60.         (setq txt1 (strcat "正在计算第" (itoa i) "物体."))
  61.         (princ txt1)
  62.       )
  63.     )
  64.   )
  65.   (close file1)
  66.   (setvar "osmode" os)
  67.   (setvar "cmdecho" om)
  68.   (princ "\nOK!")
  69.   (princ)
  70. )

  71. (DEFUN zhongxin (ENTNAME)
  72.   (setq cbiao '()
  73.         tmpbia '()
  74.   )
  75.   (setq bia (entget entname))
  76.   (setq lorpl (cdr (assoc 0 bia)))
  77.   (setq enttype lorpl)
  78.   (IF (= LORPL "POLYLINE")
  79.     (PROGN (SETQ BIA (ENTGET ENTNAME))
  80.            (SETQ SF (CDR (ASSOC 70 BIA)))
  81.            (WHILE (/= LORPL "SEQEND")
  82.              (SETQ ENTNAME (ENTNEXT ENTNAME))
  83.              (SETQ BIA (ENTGET ENTNAME))
  84.              (SETQ LORPL (CDR (ASSOC 0 BIA)))
  85.              (IF (/= LORPL "SEQEND")
  86.                (SETQ CBIAO (CONS (CDR (ASSOC 10 BIA)) CBIAO))
  87.                (IF (AND (/= LORPL "SEQEND")
  88.                         (/= (LOGAND SF 4) 0)
  89.                         (= (CDR (ASSOC 70 BIA)) 8)
  90.                    )
  91.                  (SETQ CBIAO (CONS (CDR (ASSOC 10 BIA)) CBIAO))
  92.                  (IF (AND (/= LORPL "SEQEND") (= SF 0))
  93.                    (SETQ CBIAO (CONS (CDR (ASSOC 10 BIA)) CBIAO))
  94.                  )                      ;if end
  95.                )                        ;if end
  96.              )                          ;if end
  97.            )                            ;while end
  98.            (IF (/= (LOGAND SF 1) 0)
  99.              (SETQ CBIAO (CONS (LAST CBIAO) CBIAO))
  100.            )                            ;if end
  101.     )                                   ;progn end
  102.   )
  103.   (IF (= LORPL "LWPOLYLINE")
  104.     (PROGN (SETQ BIA (ENTGET ENTNAME))
  105.            (setq pn (cdr (assoc 90 bia)))
  106.            (repeat pn
  107.              (setq tmpbia (assoc 10 bia))
  108.              (setq cbiao (cons (cdr tmpbia) cbiao))
  109.              (setq bia (cdr (member tmpbia bia)))
  110.            )
  111.     )
  112.   )
  113.   (SETQ CBIAO (REVERSE CBIAO))
  114.   (setq ii1 0
  115.         jj1 0
  116.   )
  117.   (setq x1 0
  118.         y1 0
  119.   )
  120.   (repeat (length Cbiao)
  121.     (setq pt1 (nth ii1 cbiao))
  122.     (setq x1 (+ x1 (car pt1))
  123.           y1 (+ y1 (cadr pt1))
  124.     )
  125.     (setq ii1 (+ ii1 1))
  126.   )
  127.   (setq pt12 (vlax-3D-point (/ x1 ii1) (/ y1 ii1)))
  128. )


评分

参与人数 1D豆 +5 收起 理由
newer + 5 很给力!经验;技术要点;资料分享奖!

查看全部评分

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

已领礼包: 6468个

财富等级: 富甲天下

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

使用道具 举报

已领礼包: 812个

财富等级: 财运亨通

发表于 2018-5-10 08:03:03 | 显示全部楼层
本帖最后由 liunian0524 于 2018-5-10 08:26 编辑

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

使用道具 举报

已领礼包: 568个

财富等级: 财运亨通

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

使用道具 举报

已领礼包: 3904个

财富等级: 富可敌国

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

使用道具 举报

已领礼包: 6056个

财富等级: 富甲天下

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

使用道具 举报

已领礼包: 568个

财富等级: 财运亨通

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 17:11 , Processed in 0.313426 second(s), 41 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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