长度与面积测算修改
论坛中有人的这个程序很好用，但是有些我不太想要的功能，请大家帮忙修改一下，谢谢
这个上程序测量出来的数量是，要点在图中显示的，我不想要在图中显示，不要设备字体大小，也不用在图中显示，只在命令行中能看到结果就可以了。
请朋友们帮忙修改一下，谢谢！
(defun c:AC(/ acaddoc acadspc objarea objllpoint objrupoint selectionset textbasepoint textheight textindex textobj)
(vl-load-com)
(setvar "cmdecho" 0)
(setq acaddoc (vla-get-activedocument (vlax-get-acad-object)))
(if (= (getvar "tilemode") 1)
(setq acadspc (vla-get-modelspace acaddoc))
(setq acadspc (vla-get-paperspace acaddoc))
)
(setq textbh "" ;取消前辍
textindex 1
)
(if (setq ss (ssget '((0 . "circle,lwpolyline,ellipse"))))
(progn
(setvar"dimzin"0);;保留小数位数时如果位数不足可以补零
(setq selectionset (vla-get-activeselectionset acaddoc))
(setq tarea 0 )
(vlax-for obj selectionset
(setq objarea (vla-get-area obj)
objllpoint nil
objrupoint nil
)
(vla-getboundingbox obj 'objllpoint 'objrupoint)
;;;(setq textbasepoint (mapcar '(lambda(x y) (/ (+ x y) 2)) (vlax-safearray->list objllpoint)(vlax-safearray->list objrupoint))
;;;;;;;textobj
;;;;;; (vla-addtext acadspc
;;;;;;(strcat textbh (itoa textindex) "=" (rtos (/ objarea 1e6) 2 2) "平方米");小数点向左移6位
;;;;;;(vlax-3d-point textbasepoint)
;;;;;;textheight
;;;;;;)
;;;)
;(vla-put-alignment textobj acalignmentcenter)
;(vla-put-textalignmentpoint textobj (vlax-3d-point textbasepoint))
(setq tarea (+ (/ objarea 1e6) tarea));小数点向左移6位
(setq textindex (1+ textindex))
)
(setq l (sslength ss))
(setq tarea (/ tarea 1))
(setq bb (strcat textbh "=" textbh "1+" textbh "2+...+" textbh (itoa l) "=" (rtos tarea 2 2) "平方米"))
(princ bb)
)
(vl-exit-with-error (alert "没有选中封闭图形，程序退出!"))
)
(princ)
) 其实写到图中还是比较方便查看 可以了，谢谢您。
再追问一下，这个结果反馈，可以增加显示“共统计了？个”这个信息吗 ？
页:
[1]