[编程交流] 缩放面积和长度

(defun c:test ( / doc ent format obj pt ) (vl-load-com)
   (setq format "%lu2%ct8[[color=red]0.01[/color]]") ;; Field Formatting Code
   (while
       (progn (setvar 'ERRNO 0) (setq ent (car (entsel)))
           (cond
               (   (= 7 (getvar 'ERRNO))
                   (princ "\nMissed, try again.")
               )
               (   (eq 'ENAME (type ent))
                   (if
                       (and
                           (vlax-property-available-p (setq obj (vlax-ename->vla-object ent)) '[color=red]length[/color])
                           (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-[color=red]length[/color] (list obj))))
                       )
                       (if (setq pt (getpoint "\nSpecify Point for Field: "))
                           (vla-addtext
                               (vlax-get-property (setq doc (vla-get-activedocument (vlax-get-acad-object)))
                                   (if (= 1 (getvar 'CVPORT))
                                       'Paperspace
                                       'Modelspace
                                   )
                               )
                               (strcat
                                   "%<\\AcObjProp Object(%<\\_ObjId "
                                   (if
                                       (and
                                           (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                                           (vlax-method-applicable-p (vla-get-utility doc) 'getobjectidstring)
                                       )
                                       (vla-getobjectidstring (vla-get-utility doc) obj :vlax-false)
                                       (itoa (vla-get-objectid obj))
                                   )
                                   ">%).[color=red]Length[/color] \\f "" format "">%"
                               )
                               (vlax-3D-point (trans pt 1 0))
                               (getvar 'TEXTSIZE)
                           )
                       )
                       (princ "\nInvalid Object.")
                   )
               )
           )
       )
   )
   (princ)
)

4