马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
本帖最后由 brainstorm 于 2017-8-16 22:47 编辑
以前写的一个计算面积的插件,现在用API重写了一下,
支持多义线、填充、文字、天正、斯维尔的房间对象及文字
附件是odcl文件,怕出现要密码问题
 - (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)
- )
|