cadlisp点选面积标注_请求高手帮忙解决或修改“自动标注面积周长”的lisp文件，不胜感激！...

本帖最后由 作者 于 2009-4-8 10:37:49 编辑

无意中看到论坛sailorcwx大侠的，很羡慕，努力学习了，现转帖如下，选择封闭区域，自动编号标注面积，甚是节约时间，比如几千个面积需要标注咋办？用这个lisp很快高效啊，顺便请问如何把周长长度加在面积的下面：

(defun c:markarea(/ ACADDOC ACADSPC OBJAREA OBJLLPOINT OBJRUPOINT SELECTIONSET TEXTBASEPOINT TEXTHEIGHT TEXTINDEX TEXTOBJ)

(vl-load-com)

(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 TextHeight (getdist "\n输入标注文字高度:")

TextIndex (getint "\n输入起始编号:")

)

(ssget '((0 . "LWPOLYLINE")))

(setq Selectionset (vla-get-activeselectionset AcadDoc))

(if (and TextHeight Selectionset TextIndex)

(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 (itoa TextIndex) "号面积=" (rtos ObjArea) "平方米") (vlax-3d-point TextBasePoint) TextHeight)

)

(vla-put-alignment TextObj acAlignmentCenter)

(vla-put-TextAlignmentPoint TextObj (vlax-3d-point TextBasePoint))

(setq TextIndex (1+ TextIndex))

)

)

)