统计线长及面积对话框函数
统计的线长，面积一般会显示在命令行，或发送到剪贴板，如果同时统计面积和线长的时候，发送到剪贴板就不那么方便了。
因此采用对话框的形式，可以调整两种单位，转换米制或毫米制（1:1），精度显示，补零。分别复制。
对话框函数 (sk_area_dcl aa cd )aa为面积数值 cd为长度数值
统计代码采用该贴代码。
请帮忙修改下，谢谢！http://bbs.mjtd.com/forum.php?mod=viewthread&tid=110276&fromuid=338795
(defun c:tt(/ ename i l modelspace obj ss text1 text2 totalarea totlength)
(if (setq ss (ssget'((0 . "*line,arc,circle,ellipse"))))
(progn
(vl-load-com)
(setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object))))
(setq l (sslength ss) i 0 totalarea 0 totlength 0)
(repeat l
(setq ename (ssname ss i))
(setq obj (vlax-ename->vla-object ename))
(if (vlax-property-available-p obj "area")
(setq totalarea (+ (vlax-get-property obj 'area) totalarea))
)
(if (= (cdr (assoc 0 (entget ename))) "MLINE")
(setq totlength (+ totlength (ml-length ename)))
(setq totlength (+ totlength (vlax-curve-getdistatparam ename (vlax-curve-getendparam ename))))
)
(setq i (1+ i))
)
(setq text1 (rtos (* totalarea 0.000001) 2 4))
(setq text2 (rtos (* totlength 0.001) 2 4))
(sk_area_dcltotalarea totlength)
)
)
(princ)
)
(defun ml-length (ename / j d ptlist)
(foreach n (entget ename)
(if (= (car n) 11)
(setq ptlist (cons (cdr n) ptlist))
)
)
(reverse ptlist)
(setq j 0 d 0)
(repeat (1- (length ptlist))
(setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))
(setq j (1+ j))
)
d
)
(defun sk_area_dcl(aa cd / dcl_id chk CLIP_BORD DCL F HTMSTR)
(setq bak_dimzin(getvar 'dimzin))
(if (and aa cd (numberp aa)(numberp cd))
(progn
(setq DCL (vl-filename-mktemp nil nil ".Lsp"))
(setq f (open dcl "w"))
(foreach s '(
"sk_area:dialog {"
" label = \"统计\" ;"
" :boxed_column {"
" fixed_height = true ;"
" height = 6 ;"
" label = \"统计\" ;"
" width = 70 ;"
" :column {"
" children_alignment = left ;"
" fixed_width = true ;"
" width = 50 ;"
" :row {"
" fixed_width = true ;"
" width = 35 ;"
" children_alignment = top ;"
" :edit_box {"
" key = \"sk_total_l\" ;"
" label = \"总长度:\" ;"
" fixed_width = true ;"
" width = 20 ;"
" }"
" :radio_row {"
" alignment = left ;"
" fixed_width = true ;"
" width = 16 ;"
" :radio_button {"
" label = \"米\" ;"
" value = \"1\" ;"
" key = \"sk_radio1\" ;"
" fixed_width = true ;"
" width = 8 ;"
" }"
" spacer;"
" spacer;"
" :radio_button {"
" label = \"毫米\" ;"
" key = \"sk_radio2\" ;"
" fixed_width = true ;"
" width = 8 ;"
" }"
" }"
" spacer;"
" spacer;"
" spacer;"
" :popup_list {"
" label = \"精度\" ;"
" key = \"sk_jingdu1\" ;"
" fixed_width = true ;"
" width = 20 ;"
"}"
" :button {"
" fixed_width = true ;"
" key = \"sk_copy1\" ;"
" label = \"复制(&L)\" ;"
" width = 4 ;"
" }"
" }"
" :row {"
" children_alignment = top ;"
" :edit_box {"
" key = \"sk_total_a\" ;"
" label = \"总面积:\" ;"
" fixed_width = true ;"
" width = 20 ;"
" }"
" :radio_row {"
" alignment = left ;"
" fixed_width = true ;"
" width = 16 ;"
" children_alignment = left ;"
" :radio_button {"
" label = \"平方米\" ;"
" key = \"sk_radio3\" ;"
" value = \"1\" ;"
" fixed_width = true ;"
" width = 8 ;"
" }"
" :radio_button {"
" label = \"平方毫米\" ;"
" key = \"sk_radio4\" ;"
" fixed_width = true ;"
" width = 8 ;"
" }"
" }"
" :popup_list {"
" label = \"精度\" ;"
" key = \"sk_jingdu2\" ;"
" fixed_width = true ;"
" width = 20 ;"
"}"
" :button {"
" fixed_width = true ;"
" key = \"sk_copy2\" ;"
" label = \"复制(&A)\" ;"
" width = 4 ;"
" }"
" }"
" }"
" :boxed_column {"
" alignment = centered ;"
" children_alignment = centered ;"
" :toggle {"
" key = \"sk_dimzin1\" ;"
" label = \"去零\" ;"
" value = \"1\" ;"
"}"
" :edit_box {"
" key = \"sk_paste1\" ;"
" label = \"当前剪贴板文字:\" ;"
" fixed_width = true ;"
" width = 50 ;"
" }"
" spacer;"
" spacer;"
" spacer;"
" }"
" spacer;"
" }"
" spacer;"
" ok_only;"
"}"
)
(write-line s f))
(close f)
(setq dcl_id (load_dialog DCL))
(vl-file-delete DCL)
(if (> dcl_id 0)
(progn
(setq htm (vlax-create-object "htmlfile"))
(defun sk_GetClipboard();获取剪切板
(setq Clip_Bord (Vlax-Get-Property (Vlax-Get htm 'ParentWindow) 'ClipboardData))
(Vlax-Invoke Clip_Bord 'GetData "text")
)
(defun sk_SetClipboard(clip);设置剪切板
(Vlax-Invoke Clip_Bord 'SetData "text" clip)
)
(defun sk_ClearClipboard();清空
(setq Clip_Bord (Vlax-Get-Property (Vlax-Get htm 'ParentWindow) 'ClipboardData))
(Vlax-Invoke Clip_Bord 'ClearData "text")
)
(defun Show_list(Key Newlist)
(start_list Key)
(mapcar 'add_list Newlist)
(end_list)
)
(new_dialog "sk_area" dcl_id)
(if(setq str(sk_GetClipboard))(set_Tile "sk_paste1" str))
(or jingdu01 (setq jingdu01 3))
(or jingdu02 (setq jingdu02 3))
(or sk_dimzin1 (setq sk_dimzin1 1))
(Show_list "sk_jingdu1" '( "0" "00" "000" "0000" "00000" "000000" "0000000" "00000000"))
(Show_list "sk_jingdu2" '( "0" "00" "000" "0000" "00000" "000000" "0000000" "00000000"))
(if (and jingdu01 (= (type jingdu01) 'INT))(set_tile "sk_jingdu1" (itoa (1- jingdu01))))
(if (and jingdu02 (= (type jingdu02) 'INT))(set_tile "sk_jingdu2" (itoa (1- jingdu02))))
(if (and sk_dimzin1 (= (type sk_dimzin1) 'INT))(progn (set_tile "sk_dimzin1" (itoa sk_dimzin1))(if(= sk_dimzin1 1)(setvar 'dimzin 8)(setvar 'dimzin 0))))
(if cd(set_Tile "sk_total_l" (if (= (get_Tile "sk_radio1") "1")(rtos (* cd 0.001) 2 jingdu01)(rtos cd 2 jingdu01))))
(if aa(set_Tile "sk_total_a" (if (= (get_Tile "sk_radio3") "1")(rtos (* aa 0.000001) 2 jingdu02)(rtos aa 2 jingdu02))))
(Action_Tile "sk_copy1" "(sk_SetClipboard (get_Tile \"sk_total_l\"))
(if (setq str (sk_GetClipboard))(set_Tile \"sk_paste1\" str))")
(Action_Tile "sk_copy2" "(sk_SetClipboard (get_Tile \"sk_total_a\"))
(if (setq str (sk_GetClipboard))(set_Tile \"sk_paste1\" str))")
(Action_Tile "sk_jingdu1" "(setq jingdu01 (1+ (atoi(get_tile \"sk_jingdu1\" )))) (set_Tile \"sk_total_l\" (if (= (get_Tile \"sk_radio1\") \"1\")(rtos (* cd 0.001) 2 jingdu01)(rtos cd 2 jingdu01)))")
(Action_Tile "sk_jingdu2" "(setq jingdu02 (1+ (atoi(get_tile \"sk_jingdu2\" )))) (set_Tile \"sk_total_a\" (if (= (get_Tile \"sk_radio3\") \"1\")(rtos (* aa 0.000001) 2 jingdu02)(rtos aa 2 jingdu02)))")
(Action_Tile "sk_radio1" "(set_Tile \"sk_total_l\" (rtos (* cd 0.001) 2 jingdu01))")
(Action_Tile "sk_radio2" "(set_Tile \"sk_total_l\" (rtos cd 2 jingdu01))")
(Action_Tile "sk_radio3" "(set_Tile \"sk_total_a\" (rtos (* aa 0.000001) 2 jingdu02))")
(Action_Tile "sk_radio4" "(set_Tile \"sk_total_a\" (rtos aa 2 jingdu02))")
(Action_Tile "sk_dimzin1" "(setq sk_dimzin1 (atoi (get_tile \"sk_dimzin1\" )))(if(= sk_dimzin1 1)(setvar 'dimzin 8)(setvar 'dimzin 0))
(set_Tile \"sk_total_l\" (if (= (get_Tile \"sk_radio1\") \"1\")(rtos (* cd 0.001) 2 jingdu01)(rtos cd 2 jingdu01)))
(set_Tile \"sk_total_a\" (if (= (get_Tile \"sk_radio3\") \"1\")(rtos (* aa 0.000001) 2 jingdu02)(rtos aa 2 jingdu02)))
")
(setq chk (start_dialog))
))
(unload_dialog dcl_id)
)
)
(and bak_dimzin(setvar 'dimzin bak_dimzin))
(princ)
)
一大早就看到了好东西，谢谢楼主了！ 本帖最后由 xyp1964 于 2014-6-5 08:20 编辑
(defun c:tt ()
(if (setq ss (ssget '((0 . "*line,arc,circle,ellipse"))))
(progn
(setq lst(xyp-ss2list ss)
lst1(mapcar 'xyp-CurveLength lst)
lst2(vl-remove-if '(lambda (x) (xyp-etype x "line")) lst)
lst2(mapcar '(lambda (x) (vla-get-area (vlax-ename->vla-object x))) lst2)
text1 (strcat "总面积为: " (rtos (apply '+ lst2) 2 4))
text2 (strcat "总长度为: " (rtos (apply '+ lst1) 2 4))
)
(xyp-Put-Cliptext (strcat text1 "\n" text2))
(princ "\n")(princ text1)
(princ "\n")(princ text2)
)
)
(princ)
) 本帖最后由 xiaobaixiaobu 于 2014-6-5 09:28 编辑
D:\桌面\1111咋回事？ 正在学习DCL,参考学习的好东东。感谢楼主无私奉献， xiaobaixiaobu 发表于 2014-6-5 09:26 static/image/common/back.gif
咋回事？
应该是原来剪贴板的文本超出DCL处理范围。
可以忽略。 请问E大，我想把默认改为毫米，要改哪个呢？谢谢 669423907 发表于 2018-1-12 11:08
请问E大，我想把默认改为毫米，要改哪个呢？谢谢
(defun c:tt(/ ename i l modelspace obj ss text1 text2 totalarea totlength)
(if (setq ss (ssget'((0 . "*line,arc,circle,ellipse"))))
(progn
(vl-load-com)
(setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object))))
(setq l (sslength ss) i 0 totalarea 0 totlength 0)
(repeat l
(setq ename (ssname ss i))
(setq obj (vlax-ename->vla-object ename))
(if (vlax-property-available-p obj "area")
(setq totalarea (+ (vlax-get-property obj 'area) totalarea))
)
(if (= (cdr (assoc 0 (entget ename))) "MLINE")
(setq totlength (+ totlength (ml-length ename)))
(setq totlength (+ totlength (vlax-curve-getdistatparam ename (vlax-curve-getendparam ename))))
)
(setq i (1+ i))
)
(setq text1 (rtos (* totalarea 0.000001) 2 4))
(setq text2 (rtos (* totlength 0.001) 2 4))
(sk_area_dcltotalarea totlength)
)
)
(princ)
)
(defun ml-length (ename / j d ptlist)
(foreach n (entget ename)
(if (= (car n) 11)
(setq ptlist (cons (cdr n) ptlist))
)
)
(reverse ptlist)
(setq j 0 d 0)
(repeat (1- (length ptlist))
(setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))
(setq j (1+ j))
)
d
)
(defun sk_area_dcl(aa cd / dcl_id chk CLIP_BORD DCL F HTMSTR)
(setq bak_dimzin(getvar 'dimzin))
(if (and aa cd (numberp aa)(numberp cd))
(progn
(setq DCL (vl-filename-mktemp nil nil ".Lsp"))
(setq f (open dcl "w"))
(foreach s '(
"sk_area:dialog {"
" label = \"统计\" ;"
" :boxed_column {"
" fixed_height = true ;"
" height = 6 ;"
" label = \"统计\" ;"
" width = 70 ;"
" :column {"
" children_alignment = left ;"
" fixed_width = true ;"
" width = 50 ;"
" :row {"
" fixed_width = true ;"
" width = 35 ;"
" children_alignment = top ;"
" :edit_box {"
" key = \"sk_total_l\" ;"
" label = \"总长度:\" ;"
" fixed_width = true ;"
" width = 20 ;"
" }"
" :radio_row {"
" alignment = left ;"
" fixed_width = true ;"
" width = 16 ;"
" :radio_button {"
" label = \"米\" ;"
" key = \"sk_radio1\" ;"
" fixed_width = true ;"
" width = 8 ;"
" }"
" spacer;"
" spacer;"
" :radio_button {"
" label = \"毫米\" ;"
" value = \"1\" ;"
" key = \"sk_radio2\" ;"
" fixed_width = true ;"
" width = 8 ;"
" }"
" }"
" spacer;"
" spacer;"
" spacer;"
" :popup_list {"
" label = \"精度\" ;"
" key = \"sk_jingdu1\" ;"
" fixed_width = true ;"
" width = 20 ;"
"}"
" :button {"
" fixed_width = true ;"
" key = \"sk_copy1\" ;"
" label = \"复制(&L)\" ;"
" width = 4 ;"
" }"
" }"
" :row {"
" children_alignment = top ;"
" :edit_box {"
" key = \"sk_total_a\" ;"
" label = \"总面积:\" ;"
" fixed_width = true ;"
" width = 20 ;"
" }"
" :radio_row {"
" alignment = left ;"
" fixed_width = true ;"
" width = 16 ;"
" children_alignment = left ;"
" :radio_button {"
" label = \"平方米\" ;"
" key = \"sk_radio3\" ;"
" fixed_width = true ;"
" width = 8 ;"
" }"
" :radio_button {"
" label = \"平方毫米\" ;"
" key = \"sk_radio4\" ;"
" value = \"1\" ;"
" fixed_width = true ;"
" width = 8 ;"
" }"
" }"
" :popup_list {"
" label = \"精度\" ;"
" key = \"sk_jingdu2\" ;"
" fixed_width = true ;"
" width = 20 ;"
"}"
" :button {"
" fixed_width = true ;"
" key = \"sk_copy2\" ;"
" label = \"复制(&A)\" ;"
" width = 4 ;"
" }"
" }"
" }"
" :boxed_column {"
" alignment = centered ;"
" children_alignment = centered ;"
" :toggle {"
" key = \"sk_dimzin1\" ;"
" label = \"去零\" ;"
" value = \"1\" ;"
"}"
" :edit_box {"
" key = \"sk_paste1\" ;"
" label = \"当前剪贴板文字:\" ;"
" fixed_width = true ;"
" width = 50 ;"
" }"
" spacer;"
" spacer;"
" spacer;"
" }"
" spacer;"
" }"
" spacer;"
" ok_only;"
"}"
)
(write-line s f))
(close f)
(setq dcl_id (load_dialog DCL))
(vl-file-delete DCL)
(if (> dcl_id 0)
(progn
(setq htm (vlax-create-object "htmlfile"))
(defun sk_GetClipboard();获取剪切板
(setq Clip_Bord (Vlax-Get-Property (Vlax-Get htm 'ParentWindow) 'ClipboardData))
(Vlax-Invoke Clip_Bord 'GetData "text")
)
(defun sk_SetClipboard(clip);设置剪切板
(Vlax-Invoke Clip_Bord 'SetData "text" clip)
)
(defun sk_ClearClipboard();清空
(setq Clip_Bord (Vlax-Get-Property (Vlax-Get htm 'ParentWindow) 'ClipboardData))
(Vlax-Invoke Clip_Bord 'ClearData "text")
)
(defun Show_list(Key Newlist)
(start_list Key)
(mapcar 'add_list Newlist)
(end_list)
)
(new_dialog "sk_area" dcl_id)
(if(setq str(sk_GetClipboard))(set_Tile "sk_paste1" str))
(or jingdu01 (setq jingdu01 3))
(or jingdu02 (setq jingdu02 3))
(or sk_dimzin1 (setq sk_dimzin1 1))
(Show_list "sk_jingdu1" '( "0" "00" "000" "0000" "00000" "000000" "0000000" "00000000"))
(Show_list "sk_jingdu2" '( "0" "00" "000" "0000" "00000" "000000" "0000000" "00000000"))
(if (and jingdu01 (= (type jingdu01) 'INT))(set_tile "sk_jingdu1" (itoa (1- jingdu01))))
(if (and jingdu02 (= (type jingdu02) 'INT))(set_tile "sk_jingdu2" (itoa (1- jingdu02))))
(if (and sk_dimzin1 (= (type sk_dimzin1) 'INT))(progn (set_tile "sk_dimzin1" (itoa sk_dimzin1))(if(= sk_dimzin1 1)(setvar 'dimzin 8)(setvar 'dimzin 0))))
(if cd(set_Tile "sk_total_l" (if (= (get_Tile "sk_radio1") "1")(rtos (* cd 0.001) 2 jingdu01)(rtos cd 2 jingdu01))))
(if aa(set_Tile "sk_total_a" (if (= (get_Tile "sk_radio3") "1")(rtos (* aa 0.000001) 2 jingdu02)(rtos aa 2 jingdu02))))
(Action_Tile "sk_copy1" "(sk_SetClipboard (get_Tile \"sk_total_l\"))
(if (setq str (sk_GetClipboard))(set_Tile \"sk_paste1\" str))")
(Action_Tile "sk_copy2" "(sk_SetClipboard (get_Tile \"sk_total_a\"))
(if (setq str (sk_GetClipboard))(set_Tile \"sk_paste1\" str))")
(Action_Tile "sk_jingdu1" "(setq jingdu01 (1+ (atoi(get_tile \"sk_jingdu1\" )))) (set_Tile \"sk_total_l\" (if (= (get_Tile \"sk_radio1\") \"1\")(rtos (* cd 0.001) 2 jingdu01)(rtos cd 2 jingdu01)))")
(Action_Tile "sk_jingdu2" "(setq jingdu02 (1+ (atoi(get_tile \"sk_jingdu2\" )))) (set_Tile \"sk_total_a\" (if (= (get_Tile \"sk_radio3\") \"1\")(rtos (* aa 0.000001) 2 jingdu02)(rtos aa 2 jingdu02)))")
(Action_Tile "sk_radio1" "(set_Tile \"sk_total_l\" (rtos (* cd 0.001) 2 jingdu01))")
(Action_Tile "sk_radio2" "(set_Tile \"sk_total_l\" (rtos cd 2 jingdu01))")
(Action_Tile "sk_radio3" "(set_Tile \"sk_total_a\" (rtos (* aa 0.000001) 2 jingdu02))")
(Action_Tile "sk_radio4" "(set_Tile \"sk_total_a\" (rtos aa 2 jingdu02))")
(Action_Tile "sk_dimzin1" "(setq sk_dimzin1 (atoi (get_tile \"sk_dimzin1\" )))(if(= sk_dimzin1 1)(setvar 'dimzin 8)(setvar 'dimzin 0))
(set_Tile \"sk_total_l\" (if (= (get_Tile \"sk_radio1\") \"1\")(rtos (* cd 0.001) 2 jingdu01)(rtos cd 2 jingdu01)))
(set_Tile \"sk_total_a\" (if (= (get_Tile \"sk_radio3\") \"1\")(rtos (* aa 0.000001) 2 jingdu02)(rtos aa 2 jingdu02)))
")
(setq chk (start_dialog))
))
(unload_dialog dcl_id)
)
)
(and bak_dimzin(setvar 'dimzin bak_dimzin))
(princ)
) edata 发表于 2018-1-12 11:28
非常感谢E大 edata 发表于 2018-1-12 11:28
能改为这样的对话框吗？
页:
[1]
2