统计曲线、填充、文字面积

brainstorm · 发表于 2017-8-16 21:05:26

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

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

x

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

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

QQ截图20170816210150.png

(defun c:tt (/ ss1
ss show_form1
curve_area rtnstring
get_swr_space_usearea get_swr_text_content
get_tch_text_content get_ss
getobjecttype c:cal_area_Form1_OnInitialize
c:cal_area_Form1_TextButton1_OnClicked
c:cal_area_Form1_OnClose
myerr newerr
set_checkbox_state get_checkbox_state
dragtext *error*
e
)
;;;----------------------------------------------------------------------
(vl-acad-defun 'dragtext)
(defun dragtext (p)
(xdrx_modent 10 p)
)
;;;----------------------------------------------------------------------
(defun *error* (msg)
(princ "\n操作已取消!")
(if cal_area_loaded_p
(dcl_project_unload "cal_area")
)
(setq cal_area_loaded_p nil)
)
;;;---图元过滤初始值----------------------------------------------------
(if (not area_obj_type)
(setq area_obj_type
'((0 . "*POLYLINE,CIRCLE,ARC,SWR_SPACE,TCH_SPACE"))
)
)
(if (not cal_area_checkbox_state)
(setq cal_area_checkbox_state '(0 0 0 1 1))
)
(setq cal_area_loaded_p nil)
(defun get_ss ()
(if (not (setq ss (ssget area_obj_type)))
(progn (show_form1)
(prompt "选择计算面积的图元(右键设置匹配图元类别):")
(get_ss)
)
)
)
;;;swr房间使用面积------------------------------------------------------
(defun get_swr_space_usearea (en)
(vlax-get en 'usearea)
)
;;;swr文字值----------------------------------------------------------
(defun get_swr_text_content (en)
(vlax-get en 'CONTENT)
)
(defun get_tch_text_content (en)
(vlax-get en 'TEXT)
)
;;取得checkbox状态----------------------------------------------------
(defun get_checkbox_state (lst)
(mapcar '(lambda (x)
(dcl_control_getvalue x)
)
lst
)
)
;;设置checkbox状态----------------------------------------------------
(defun set_checkbox_state (lst1 lst2)
(mapcar '(lambda (a b)
(dcl_control_setvalue a b)
)
lst1
lst2
)
)
;;表格初始化----------------------------------------------------------
(defun c:cal_area_Form1_OnInitialize (/)
(set_checkbox_state
(list
cal_area_Form1_CheckBox1
cal_area_Form1_CheckBox2
cal_area_Form1_CheckBox3
cal_area_Form1_CheckBox4
cal_area_Form1_CheckBox5
)
cal_area_checkbox_state
)
(setq cal_area_checkbox_state
(get_checkbox_state
(list
cal_area_Form1_CheckBox1
cal_area_Form1_CheckBox2
cal_area_Form1_CheckBox3
cal_area_Form1_CheckBox4
cal_area_Form1_CheckBox5
)
)
)
)
;;;okbtn-----------------------------------------------------------------
(defun c:cal_area_Form1_TextButton1_OnClicked (/)
(setq cal_area_checkbox_state
(get_checkbox_state
(list
cal_area_Form1_CheckBox1
cal_area_Form1_CheckBox2
cal_area_Form1_CheckBox3
cal_area_Form1_CheckBox4
cal_area_Form1_CheckBox5
)
)
)
(setq area_obj_type
(getobjecttype
cal_area_checkbox_state
'("TEXT" "SWR_TEXT,TCH_TEXT"
"HATCH" "SWR_SPACE,TCH_SPACE"
"*POLYLINE,ARC,CIRCLE"
)
)
)
(dcl_form_close cal_area_Form1)
)
(defun c:cal_area_Form1_OnClose (UpperLeftX UpperLeftY /)
(c:cal_area_Form1_TextButton1_OnClicked)
)
(command "_opendcl")
;;显示对话框-----------------------------------------------------------
(defun show_form1 ()
(_Load_ODCL_Embedded_Project "cal_area.odcl" nil nil)
(setq cal_area_loaded_p
(dcl_project_load
"cal_area"
)
)
(dcl_form_show cal_area_form1)
)
;;取得图元过滤类别----------------------------------------------------
(defun getobjecttype (lst1 lst2 / string)
(setq string "")
(mapcar '(lambda (a b)
(if (= 1 a)
(setq string (strcat string b ","))
)
)
lst1
lst2
)
(setq string (vl-string-right-trim "," string))
(list (cons 0 string))
)
;;计算面积-------------------------------------------------------------
(defun ss_area (ss / area n en total_area)
(setq area 0
n -1
total_area
0
)
(repeat (sslength ss)
(setq en (ssname ss (setq n (1+ n))))
(xdrx_setenttodb en)
(cond
((wcmatch (xdrx_getentdxf 0) "*POLYLINE,HATCH,CIRCLE,ARC")
(setq area (* 1e-6 (xdrx_getpropertyvalue en "area"))
)
)
((wcmatch (xdrx_getentdxf 0) "SWR_TEXT")
(setq area
(atof (get_swr_text_content (vlax-ename->vla-object en)))
)
)
((wcmatch (xdrx_getentdxf 0) "TCH_TEXT")
(setq area
(atof (get_tch_text_content (vlax-ename->vla-object en)))
)
)
((wcmatch (xdrx_getentdxf 0) "TEXT")
(setq area
(atof (xdrx_getpropertyvalue en "textstring"))
)
)
((wcmatch (xdrx_getentdxf 0) "SWR_SPACE,TCH_SPACE")
(setq
area (atof
(get_swr_space_usearea (vlax-ename->vla-object en))
)
)
)
)
(setq total_area (+ area total_area))
)
total_area
)
(prompt "\n选择求面积图元(右键设置匹配图元类别):")
(get_ss)
(prompt "\n选择求减去的面积:")
(setq ss1 (ssget area_obj_type))
(setq rtnstring
(rtos
(- (ss_area ss)
(if ss1
(ss_area ss1)
0
)
)
2
2
)
)
(setq e
(xdrx_text_make
'(0 0 0)
rtnstring
300
0
)
)
(xdrx_setenttodb e)
(xdrx_sysvar_push '("orthomode" 0))
(setq pt
(xdrx_drag_jig
"dragtext"
"请选择文字标注点(右键不注):"
""
(+ 0 2 128 512)
0
'(0 0 0)
)
)
(xdrx_document_setClipBoard rtnstring)
(xdrx_sysvar_pop)
(if (or (not pt)
(equal -1 pt)
)
(entdel e)
)
(princ (strcat "\n" rtnstring))
(if cal_area_loaded_p
(dcl_project_unload "cal_area")
)
(setq cal_area_loaded_p nil)
(princ)
)

(defun c:tt (/                             ss1 
             ss                             show_form1 
             curve_area                     rtnstring 
             get_swr_space_usearea   get_swr_text_content 
             get_tch_text_content    get_ss 
             getobjecttype             c:cal_area_Form1_OnInitialize 
             c:cal_area_Form1_TextButton1_OnClicked 
             c:cal_area_Form1_OnClose 
             myerr                     newerr 
             set_checkbox_state             get_checkbox_state 
             dragtext                     *error* 
             e 
            ) 
;;;---------------------------------------------------------------------- 
  (vl-acad-defun 'dragtext) 
  (defun dragtext (p) 
    (xdrx_modent 10 p) 
  ) 
;;;---------------------------------------------------------------------- 
  (defun *error*       (msg) 
    (princ "\n操作已取消!") 
    (if        cal_area_loaded_p 
      (dcl_project_unload "cal_area") 
    ) 
    (setq cal_area_loaded_p nil) 
 
  ) 
;;;---图元过滤初始值---------------------------------------------------- 
  (if (not area_obj_type) 
    (setq area_obj_type 
           '((0 . "*POLYLINE,CIRCLE,ARC,SWR_SPACE,TCH_SPACE")) 
    ) 
  ) 
  (if (not cal_area_checkbox_state) 
    (setq cal_area_checkbox_state '(0 0 0 1 1)) 
  ) 
  (setq cal_area_loaded_p nil) 
 
  (defun get_ss        () 
    (if        (not (setq ss (ssget area_obj_type))) 
      (progn (show_form1) 
             (prompt "选择计算面积的图元(右键设置匹配图元类别):") 
             (get_ss) 
      ) 
    ) 
  ) 
;;;swr房间使用面积------------------------------------------------------ 
  (defun get_swr_space_usearea (en) 
    (vlax-get en 'usearea) 
  ) 
 
  ;;;swr文字值---------------------------------------------------------- 
  (defun get_swr_text_content (en) 
    (vlax-get en 'CONTENT) 
  ) 
  (defun get_tch_text_content (en) 
    (vlax-get en 'TEXT) 
  ) 
  ;;取得checkbox状态---------------------------------------------------- 
  (defun get_checkbox_state (lst) 
    (mapcar '(lambda (x) 
               (dcl_control_getvalue x) 
             ) 
            lst 
    ) 
  ) 
  ;;设置checkbox状态---------------------------------------------------- 
  (defun set_checkbox_state (lst1 lst2) 
    (mapcar '(lambda (a b) 
               (dcl_control_setvalue a b) 
             ) 
            lst1 
            lst2 
    ) 
  ) 
  ;;表格初始化---------------------------------------------------------- 
  (defun c:cal_area_Form1_OnInitialize (/) 
    (set_checkbox_state 
      (list 
        cal_area_Form1_CheckBox1 
        cal_area_Form1_CheckBox2 
        cal_area_Form1_CheckBox3 
        cal_area_Form1_CheckBox4 
        cal_area_Form1_CheckBox5 
       ) 
      cal_area_checkbox_state 
    ) 
    (setq cal_area_checkbox_state 
           (get_checkbox_state 
             (list 
               cal_area_Form1_CheckBox1 
               cal_area_Form1_CheckBox2 
               cal_area_Form1_CheckBox3 
               cal_area_Form1_CheckBox4 
               cal_area_Form1_CheckBox5 
              ) 
           ) 
    ) 
  ) 
;;;okbtn----------------------------------------------------------------- 
  (defun c:cal_area_Form1_TextButton1_OnClicked        (/) 
    (setq cal_area_checkbox_state 
           (get_checkbox_state 
             (list 
               cal_area_Form1_CheckBox1 
               cal_area_Form1_CheckBox2 
               cal_area_Form1_CheckBox3 
               cal_area_Form1_CheckBox4 
               cal_area_Form1_CheckBox5 
              ) 
           ) 
    ) 
    (setq area_obj_type 
           (getobjecttype 
             cal_area_checkbox_state 
             '("TEXT"                        "SWR_TEXT,TCH_TEXT" 
               "HATCH"                        "SWR_SPACE,TCH_SPACE" 
               "*POLYLINE,ARC,CIRCLE" 
              ) 
           ) 
    ) 
    (dcl_form_close cal_area_Form1) 
  ) 
 
  (defun c:cal_area_Form1_OnClose (UpperLeftX UpperLeftY /) 
    (c:cal_area_Form1_TextButton1_OnClicked) 
  ) 
  (command "_opendcl") 
  ;;显示对话框----------------------------------------------------------- 
  (defun show_form1 () 
    (_Load_ODCL_Embedded_Project "cal_area.odcl" nil nil) 
    (setq cal_area_loaded_p 
           (dcl_project_load 
             "cal_area" 
           ) 
    ) 
    (dcl_form_show cal_area_form1) 
  ) 
  ;;取得图元过滤类别---------------------------------------------------- 
  (defun getobjecttype (lst1 lst2 / string) 
    (setq string "") 
    (mapcar '(lambda (a b) 
               (if (= 1 a) 
                 (setq string (strcat string b ",")) 
               ) 
             ) 
            lst1 
            lst2 
    ) 
    (setq string (vl-string-right-trim "," string)) 
    (list (cons 0 string)) 
  ) 
  ;;计算面积------------------------------------------------------------- 
  (defun ss_area (ss / area n en total_area) 
    (setq area 0 
          n -1 
          total_area 
           0 
    ) 
    (repeat (sslength ss) 
      (setq en (ssname ss (setq n (1+ n)))) 
      (xdrx_setenttodb en) 
      (cond 
        ((wcmatch (xdrx_getentdxf 0) "*POLYLINE,HATCH,CIRCLE,ARC") 
         (setq area (* 1e-6 (xdrx_getpropertyvalue en "area")) 
         ) 
        ) 
        ((wcmatch (xdrx_getentdxf 0) "SWR_TEXT") 
         (setq area 
                (atof (get_swr_text_content (vlax-ename->vla-object en))) 
         ) 
        ) 
        ((wcmatch (xdrx_getentdxf 0) "TCH_TEXT") 
         (setq area 
                (atof (get_tch_text_content (vlax-ename->vla-object en))) 
         ) 
        ) 
        ((wcmatch (xdrx_getentdxf 0) "TEXT") 
         (setq area 
                (atof (xdrx_getpropertyvalue en "textstring")) 
         ) 
        ) 
        ((wcmatch (xdrx_getentdxf 0) "SWR_SPACE,TCH_SPACE") 
         (setq 
           area        (atof 
                  (get_swr_space_usearea (vlax-ename->vla-object en)) 
                ) 
         ) 
        ) 
      ) 
      (setq total_area (+ area total_area)) 
    ) 
    total_area 
  ) 
  (prompt "\n选择求面积图元(右键设置匹配图元类别):") 
  (get_ss) 
  (prompt "\n选择求减去的面积:") 
  (setq ss1 (ssget area_obj_type)) 
  (setq        rtnstring 
         (rtos 
           (- (ss_area ss) 
              (if ss1 
                (ss_area ss1) 
                0 
              ) 
           ) 
           2 
           2 
         ) 
  ) 
  (setq        e 
         (xdrx_text_make 
           '(0 0 0) 
           rtnstring 
           300 
           0 
         ) 
 
  ) 
  (xdrx_setenttodb e) 
  (xdrx_sysvar_push '("orthomode" 0)) 
  (setq        pt 
         (xdrx_drag_jig 
           "dragtext" 
           "请选择文字标注点(右键不注):" 
           "" 
           (+ 0 2 128 512) 
           0 
           '(0 0 0) 
         ) 
  ) 
 (xdrx_document_setClipBoard rtnstring) 
  (xdrx_sysvar_pop) 
  (if (or (not pt) 
          (equal -1 pt) 
      ) 
    (entdel e) 
  ) 
  (princ (strcat "\n" rtnstring)) 
  (if cal_area_loaded_p 
    (dcl_project_unload "cal_area") 
  ) 
  (setq cal_area_loaded_p nil) 
  (princ) 
)

请点击此处下载

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

您的用户组是：游客

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

yangjian001 · 发表于 2017-8-17 08:05:59

怕出现要密码问题

liunian0524 · 发表于 2017-8-17 13:41:44

感谢楼主分享,

愤怒的菜鸟 · 发表于 2017-8-18 08:33:37

感谢分享，学习下！

yangjian001 · 发表于 2017-8-25 08:44:55

可能会有你要找的答案

abenmao168 · 发表于 2017-8-25 09:47:29

很好喜欢填充功能

dl1770621030 · 发表于 2017-8-25 11:19:07

很给力啊

7079977a · 发表于 2019-1-30 16:58:07

好东西，真的不错，收藏了！

dongf2008 · 发表于 2019-3-11 15:43:00

谢谢楼主分享

都小群 · 发表于 2019-5-17 14:36:31

很好喜欢填充功能

h3161596 · 发表于 2019-7-5 17:04:40

太实用了！！！！！！！！

kmliro_2017 · 发表于 2019-7-6 07:26:34

谢谢分享！

z562261070 · 发表于 2019-7-6 21:39:22

这个咋用啊

andysama · 发表于 2019-7-12 20:03:54

感谢楼主分享~~

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

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

评分

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