长度与面积测算修改

nyistjz

论坛中有人的这个程序很好用，但是有些我不太想要的功能，请大家帮忙修改一下，谢谢
这个上程序测量出来的数量是，要点在图中显示的，我不想要在图中显示，不要设备字体大小，也不用在图中显示，只在命令行中能看到结果就可以了。

请朋友们帮忙修改一下，谢谢！

jun353835273

1. (defun c:AC(/ acaddoc acadspc objarea objllpoint objrupoint selectionset textbasepoint textheight textindex textobj)
   
2. (vl-load-com)
   
3. (setvar "cmdecho" 0)
   
4. (setq acaddoc (vla-get-activedocument (vlax-get-acad-object)))
   
5. (if (= (getvar "tilemode") 1)
   
6. (setq acadspc (vla-get-modelspace acaddoc))
   
7. (setq acadspc (vla-get-paperspace acaddoc))
   
8. )
   
9. (setq textbh "" ;取消前辍
   
10. textindex 1
    
11. )
    
12. (if (setq ss (ssget '((0 . "circle,lwpolyline,ellipse"))))
    
13. (progn
    
14. (setvar"dimzin"0);;保留小数位数时如果位数不足可以补零
    
15. (setq selectionset (vla-get-activeselectionset acaddoc))
    
16. (setq tarea 0 )
    
17. (vlax-for obj selectionset
    
18. (setq objarea (vla-get-area obj)
    
19. objllpoint nil
    
20. objrupoint nil
    
21. )
    
22. (vla-getboundingbox obj 'objllpoint 'objrupoint)
    
23. ;;;(setq textbasepoint (mapcar '(lambda(x y) (/ (+ x y) 2)) (vlax-safearray->list objllpoint)(vlax-safearray->list objrupoint))
    
24. ;;;;;;;textobj
    
25. ;;;;;; (vla-addtext acadspc
    
26. ;;;;;;(strcat textbh (itoa textindex) "=" (rtos (/ objarea 1e6) 2 2) "平方米");小数点向左移6位
    
27. ;;;;;;(vlax-3d-point textbasepoint)
    
28. ;;;;;;textheight
    
29. ;;;;;;)
    
30. ;;;)
    
31. ;(vla-put-alignment textobj acalignmentcenter)
    
32. ;(vla-put-textalignmentpoint textobj (vlax-3d-point textbasepoint))
    
33. (setq tarea (+ (/ objarea 1e6) tarea));小数点向左移6位
    
34. (setq textindex (1+ textindex))
    
35. )
    
36. (setq l (sslength ss))
    
37. (setq tarea (/ tarea 1))
    
38. (setq bb (strcat textbh "=" textbh "1+" textbh "2+...+" textbh (itoa l) "=" (rtos tarea 2 2) "平方米"))
    
39. (princ bb)
    
40. )
    
41. (vl-exit-with-error (alert "没有选中封闭图形，程序退出!"))
    
42. )
    
43. (princ)
    
44. )

(defun c:AC(/ acaddoc acadspc objarea objllpoint objrupoint selectionset textbasepoint textheight textindex textobj)<br /> (vl-load-com)<br /> (setvar "cmdecho" 0)<br /> (setq acaddoc (vla-get-activedocument (vlax-get-acad-object)))<br /> (if (= (getvar "tilemode") 1)<br /> (setq acadspc (vla-get-modelspace acaddoc))<br /> (setq acadspc (vla-get-paperspace acaddoc))<br /> )<br /> (setq textbh "" ;取消前辍<br /> textindex 1<br /> )<br /> (if (setq ss (ssget '((0 . "circle,lwpolyline,ellipse"))))<br /> (progn<br /> (setvar"dimzin"0);;保留小数位数时如果位数不足可以补零<br /> (setq selectionset (vla-get-activeselectionset acaddoc))<br /> (setq tarea 0 )<br /> (vlax-for obj selectionset<br /> (setq objarea (vla-get-area obj)<br /> objllpoint nil<br /> objrupoint nil<br /> )<br /> (vla-getboundingbox obj 'objllpoint 'objrupoint)<br /> ;;;(setq textbasepoint (mapcar '(lambda(x y) (/ (+ x y) 2)) (vlax-safearray->list objllpoint)(vlax-safearray->list objrupoint))<br /> ;;;;;;;textobj<br /> ;;;;;; (vla-addtext acadspc<br /> ;;;;;;(strcat textbh (itoa textindex) "=" (rtos (/ objarea 1e6) 2 2) "平方米");小数点向左移6位<br /> ;;;;;;(vlax-3d-point textbasepoint)<br /> ;;;;;;textheight<br /> ;;;;;;)<br /> ;;;)<br /> ;(vla-put-alignment textobj acalignmentcenter)<br /> ;(vla-put-textalignmentpoint textobj (vlax-3d-point textbasepoint))<br /> (setq tarea (+ (/ objarea 1e6) tarea));小数点向左移6位<br /> (setq textindex (1+ textindex))<br /> )<br /> (setq l (sslength ss))<br /> (setq tarea (/ tarea 1))<br /> (setq bb (strcat textbh "=" textbh "1+" textbh "2+...+" textbh (itoa l) "=" (rtos tarea 2 2) "平方米"))<br /> (princ bb)<br /> )<br /> (vl-exit-with-error (alert "没有选中封闭图形，程序退出!"))<br /> )<br /> (princ)<br /> )

jun353835273

其实写到图中还是比较方便查看

nyistjz

可以了，谢谢您。

nyistjz

再追问一下，这个结果反馈，可以增加显示“共统计了？个”这个信息吗 ？