[编程交流] 带面积字段的多边形

(defun c:test (/ doc e o u spc reg obj mt p)
 ;;    Tharwat 19.11.2015    ;;;
 (setq e (entlast))
 (if (and (vl-cmdf "_.-boundary" "\" "\")
          (setq o (entlast))
          (not (eq e o))
          (eq (cdr (assoc 0 (entget o))) "LWPOLYLINE")
     )
   (progn
     (setq doc (vla-get-activedocument (vlax-get-acad-object))
           spc (vla-get-block
                 (vla-item (vla-get-layouts doc) (getvar 'ctab))
               )
           reg (vlax-invoke
                 spc
                 'addregion
                 (list (setq obj (vlax-ename->vla-object o)))
               )
     )
     (if (setq
           p  (vlax-3d-point
                (append (vlax-get (car reg) 'centroid) (list 0.))
              )
           mt (vla-addmtext
                spc
                p
                0.0
                (strcat
                  "%<\\AcObjProp Object(%<\\_ObjId "
                  (if (vlax-method-applicable-p
                        (setq
                          u (vla-get-utility
                              doc
                            )
                        )
                        'getobjectidstring
                      )
                    (vla-getobjectidstring u obj :vlax-false)
                    (itoa (vla-get-objectid obj))
                  )
                  ">%).Area \\f "%lu6%qf1">%"
                )
              )
         )
       (progn
         (vla-put-attachmentpoint mt acmiddlecenter)
         (vla-move mt (vla-get-insertionpoint mt) p)
       )
     )
     (vla-delete (car reg))
   )
 )
 (princ)
)
(vl-load-com)