[编程交流] Lisp面积和/或po长度

(vlax-put mtx 'Height (getvar "textsize"))

(vlax-put mtx 'Height 250.0); -->change text size to suit here

Area = 244.86
Perimeter = 62.89

(defun c:fa  (/ acsp adoc cpt elist en ent fld lead_obj lpt mtx oid osm)
 (vl-load-com)
 (or adoc
     (setq adoc
        (vla-get-activedocument
          (vlax-get-acad-object)
          )
       )
     )
 (if (and
   (= (getvar "tilemode") 0)
   (= (getvar "cvport") 1)
   )
   (setq acsp (vla-get-paperspace adoc))
   (setq acsp (vla-get-modelspace adoc))
   )
 (setq osm (getvar "osmode"))
 (setvar "osmode" 0)
 (while
   (setq ent (entsel "\nSelect pline or hit Enter to exit"))
    (setq en (car ent))
    (if (wcmatch (cdr (assoc 0 (setq elist (entget en)))) "*POLYLINE")
      (progn
    (setq cpt (trans (cadr ent) 1 0)
          lpt (trans (getpoint cpt "\nPick the ending point of leader:") 1 0)
          )
    (setq oid (vla-get-objectid (vlax-ename->vla-object en)))
    (setq fld
       (strcat
         (strcat "%<\\AcObjProp Object(%<\\_ObjId "
             (itoa oid)
             ">%).Area \\f "%lu2%pr2">%"
             "\\P")
         (strcat "%<\\AcObjProp Object(%<\\_ObjId "
             (itoa oid)
             ">%).Length \\f "%lu2%pr2">%"))
          )
    (setq mtx (vlax-invoke
            acsp 'addmtext lpt    0.0 fld)
          )
    (vlax-put mtx
          'attachmentpoint
          (cond ((> (car cpt) (car lpt))
             6
             )
            ((< (car cpt) (car lpt))
             4
             )
            (t 4)
            )
          )
    (vlax-put mtx 'height (getvar "textsize"))
    (setq lead_obj    (vlax-invoke
             acsp
             'addleader
             (apply 'append (list cpt lpt))
             mtx
             aclinewitharrow
             )
          )
    (vlax-put lead_obj 'verticaltextposition 0) ;1
    )
      )
    )
 (setvar "osmode" osm)
 (princ)
 )
(princ "\n Start command with FA ...")
(princ)