设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1408|回复: 13

[工具] 统计曲线、填充、文字面积

[复制链接]

已领礼包: 57个

财富等级: 招财进宝

发表于 2017-8-16 21:05:26 | 显示全部楼层 |阅读模式

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

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

x
本帖最后由 brainstorm 于 2017-8-16 22:47 编辑

以前写的一个计算面积的插件,现在用API重写了一下,
支持多义线、填充、文字、天正、斯维尔的房间对象及文字
附件是odcl文件,怕出现要密码问题

QQ截图20170816210150.png

  1. (defun c:tt (/                             ss1
  2.              ss                             show_form1
  3.              curve_area                     rtnstring
  4.              get_swr_space_usearea   get_swr_text_content
  5.              get_tch_text_content    get_ss
  6.              getobjecttype             c:cal_area_Form1_OnInitialize
  7.              c:cal_area_Form1_TextButton1_OnClicked
  8.              c:cal_area_Form1_OnClose
  9.              myerr                     newerr
  10.              set_checkbox_state             get_checkbox_state
  11.              dragtext                     *error*
  12.              e
  13.             )
  14. ;;;----------------------------------------------------------------------
  15.   (vl-acad-defun 'dragtext)
  16.   (defun dragtext (p)
  17.     (xdrx_modent 10 p)
  18.   )
  19. ;;;----------------------------------------------------------------------
  20.   (defun *error*       (msg)
  21.     (princ "\n操作已取消!")
  22.     (if        cal_area_loaded_p
  23.       (dcl_project_unload "cal_area")
  24.     )
  25.     (setq cal_area_loaded_p nil)

  26.   )
  27. ;;;---图元过滤初始值----------------------------------------------------
  28.   (if (not area_obj_type)
  29.     (setq area_obj_type
  30.            '((0 . "*POLYLINE,CIRCLE,ARC,SWR_SPACE,TCH_SPACE"))
  31.     )
  32.   )
  33.   (if (not cal_area_checkbox_state)
  34.     (setq cal_area_checkbox_state '(0 0 0 1 1))
  35.   )
  36.   (setq cal_area_loaded_p nil)

  37.   (defun get_ss        ()
  38.     (if        (not (setq ss (ssget area_obj_type)))
  39.       (progn (show_form1)
  40.              (prompt "选择计算面积的图元(右键设置匹配图元类别):")
  41.              (get_ss)
  42.       )
  43.     )
  44.   )
  45. ;;;swr房间使用面积------------------------------------------------------
  46.   (defun get_swr_space_usearea (en)
  47.     (vlax-get en 'usearea)
  48.   )

  49.   ;;;swr文字值----------------------------------------------------------
  50.   (defun get_swr_text_content (en)
  51.     (vlax-get en 'CONTENT)
  52.   )
  53.   (defun get_tch_text_content (en)
  54.     (vlax-get en 'TEXT)
  55.   )
  56.   ;;取得checkbox状态----------------------------------------------------
  57.   (defun get_checkbox_state (lst)
  58.     (mapcar '(lambda (x)
  59.                (dcl_control_getvalue x)
  60.              )
  61.             lst
  62.     )
  63.   )
  64.   ;;设置checkbox状态----------------------------------------------------
  65.   (defun set_checkbox_state (lst1 lst2)
  66.     (mapcar '(lambda (a b)
  67.                (dcl_control_setvalue a b)
  68.              )
  69.             lst1
  70.             lst2
  71.     )
  72.   )
  73.   ;;表格初始化----------------------------------------------------------
  74.   (defun c:cal_area_Form1_OnInitialize (/)
  75.     (set_checkbox_state
  76.       (list
  77.         cal_area_Form1_CheckBox1
  78.         cal_area_Form1_CheckBox2
  79.         cal_area_Form1_CheckBox3
  80.         cal_area_Form1_CheckBox4
  81.         cal_area_Form1_CheckBox5
  82.        )
  83.       cal_area_checkbox_state
  84.     )
  85.     (setq cal_area_checkbox_state
  86.            (get_checkbox_state
  87.              (list
  88.                cal_area_Form1_CheckBox1
  89.                cal_area_Form1_CheckBox2
  90.                cal_area_Form1_CheckBox3
  91.                cal_area_Form1_CheckBox4
  92.                cal_area_Form1_CheckBox5
  93.               )
  94.            )
  95.     )
  96.   )
  97. ;;;okbtn-----------------------------------------------------------------
  98.   (defun c:cal_area_Form1_TextButton1_OnClicked        (/)
  99.     (setq cal_area_checkbox_state
  100.            (get_checkbox_state
  101.              (list
  102.                cal_area_Form1_CheckBox1
  103.                cal_area_Form1_CheckBox2
  104.                cal_area_Form1_CheckBox3
  105.                cal_area_Form1_CheckBox4
  106.                cal_area_Form1_CheckBox5
  107.               )
  108.            )
  109.     )
  110.     (setq area_obj_type
  111.            (getobjecttype
  112.              cal_area_checkbox_state
  113.              '("TEXT"                        "SWR_TEXT,TCH_TEXT"
  114.                "HATCH"                        "SWR_SPACE,TCH_SPACE"
  115.                "*POLYLINE,ARC,CIRCLE"
  116.               )
  117.            )
  118.     )
  119.     (dcl_form_close cal_area_Form1)
  120.   )

  121.   (defun c:cal_area_Form1_OnClose (UpperLeftX UpperLeftY /)
  122.     (c:cal_area_Form1_TextButton1_OnClicked)
  123.   )
  124.   (command "_opendcl")
  125.   ;;显示对话框-----------------------------------------------------------
  126.   (defun show_form1 ()
  127.     (_Load_ODCL_Embedded_Project "cal_area.odcl" nil nil)
  128.     (setq cal_area_loaded_p
  129.            (dcl_project_load
  130.              "cal_area"
  131.            )
  132.     )
  133.     (dcl_form_show cal_area_form1)
  134.   )
  135.   ;;取得图元过滤类别----------------------------------------------------
  136.   (defun getobjecttype (lst1 lst2 / string)
  137.     (setq string "")
  138.     (mapcar '(lambda (a b)
  139.                (if (= 1 a)
  140.                  (setq string (strcat string b ","))
  141.                )
  142.              )
  143.             lst1
  144.             lst2
  145.     )
  146.     (setq string (vl-string-right-trim "," string))
  147.     (list (cons 0 string))
  148.   )
  149.   ;;计算面积-------------------------------------------------------------
  150.   (defun ss_area (ss / area n en total_area)
  151.     (setq area 0
  152.           n -1
  153.           total_area
  154.            0
  155.     )
  156.     (repeat (sslength ss)
  157.       (setq en (ssname ss (setq n (1+ n))))
  158.       (xdrx_setenttodb en)
  159.       (cond
  160.         ((wcmatch (xdrx_getentdxf 0) "*POLYLINE,HATCH,CIRCLE,ARC")
  161.          (setq area (* 1e-6 (xdrx_getpropertyvalue en "area"))
  162.          )
  163.         )
  164.         ((wcmatch (xdrx_getentdxf 0) "SWR_TEXT")
  165.          (setq area
  166.                 (atof (get_swr_text_content (vlax-ename->vla-object en)))
  167.          )
  168.         )
  169.         ((wcmatch (xdrx_getentdxf 0) "TCH_TEXT")
  170.          (setq area
  171.                 (atof (get_tch_text_content (vlax-ename->vla-object en)))
  172.          )
  173.         )
  174.         ((wcmatch (xdrx_getentdxf 0) "TEXT")
  175.          (setq area
  176.                 (atof (xdrx_getpropertyvalue en "textstring"))
  177.          )
  178.         )
  179.         ((wcmatch (xdrx_getentdxf 0) "SWR_SPACE,TCH_SPACE")
  180.          (setq
  181.            area        (atof
  182.                   (get_swr_space_usearea (vlax-ename->vla-object en))
  183.                 )
  184.          )
  185.         )
  186.       )
  187.       (setq total_area (+ area total_area))
  188.     )
  189.     total_area
  190.   )
  191.   (prompt "\n选择求面积图元(右键设置匹配图元类别):")
  192.   (get_ss)
  193.   (prompt "\n选择求减去的面积:")
  194.   (setq ss1 (ssget area_obj_type))
  195.   (setq        rtnstring
  196.          (rtos
  197.            (- (ss_area ss)
  198.               (if ss1
  199.                 (ss_area ss1)
  200.                 0
  201.               )
  202.            )
  203.            2
  204.            2
  205.          )
  206.   )
  207.   (setq        e
  208.          (xdrx_text_make
  209.            '(0 0 0)
  210.            rtnstring
  211.            300
  212.            0
  213.          )

  214.   )
  215.   (xdrx_setenttodb e)
  216.   (xdrx_sysvar_push '("orthomode" 0))
  217.   (setq        pt
  218.          (xdrx_drag_jig
  219.            "dragtext"
  220.            "请选择文字标注点(右键不注):"
  221.            ""
  222.            (+ 0 2 128 512)
  223.            0
  224.            '(0 0 0)
  225.          )
  226.   )
  227. (xdrx_document_setClipBoard rtnstring)
  228.   (xdrx_sysvar_pop)
  229.   (if (or (not pt)
  230.           (equal -1 pt)
  231.       )
  232.     (entdel e)
  233.   )
  234.   (princ (strcat "\n" rtnstring))
  235.   (if cal_area_loaded_p
  236.     (dcl_project_unload "cal_area")
  237.   )
  238.   (setq cal_area_loaded_p nil)
  239.   (princ)
  240. )


请点击此处下载

查看状态:需购买或无权限

您的用户组是:游客

文件名称:cal_area.rar 
下载次数:71  文件大小:937 Bytes 
下载权限: 不限 以上  [免费赚D豆]


评分

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

查看全部评分

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

已领礼包: 3709个

财富等级: 富可敌国

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

使用道具 举报

已领礼包: 811个

财富等级: 财运亨通

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

使用道具 举报

已领礼包: 194个

财富等级: 日进斗金

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

使用道具 举报

已领礼包: 3709个

财富等级: 富可敌国

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

使用道具 举报

已领礼包: 233个

财富等级: 日进斗金

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

使用道具 举报

已领礼包: 1个

财富等级: 恭喜发财

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

使用道具 举报

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

使用道具 举报

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

使用道具 举报

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

使用道具 举报

已领礼包: 20个

财富等级: 恭喜发财

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

使用道具 举报

已领礼包: 225个

财富等级: 日进斗金

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

使用道具 举报

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

使用道具 举报

已领礼包: 1个

财富等级: 恭喜发财

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2021-9-23 02:34 , Processed in 0.833873 second(s), 61 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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