;;; ---------------------------------------------------------------------------
;;; AreaSchedule.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Numbers areas on the drawing and schedules them - either into an AutoCAD
;;; table or out to a file.
;;;
;;; Click inside a room and it is labelled 1, its area added to the schedule.
;;; Click the next and it is 2. You get a numbered plan and a matching table
;;; without transcribing anything.
;;;
;;; COMMANDS
;;;   AREATABLE  - build the schedule as an AutoCAD table in the drawing
;;;   AREAFILE   - write it to a TXT, CSV or XLS file, opened automatically
;;;
;;; TWO WAYS TO IDENTIFY AN AREA
;;;   Pick   - click inside an enclosed region and the boundary is traced for
;;;            you, exactly as the BOUNDARY command would. The traced boundary
;;;            is temporary and removed afterwards.
;;;   Object - select an existing closed object directly.
;;;
;;; Switch between them at the prompt; the choice is remembered between
;;; sessions. Undo removes the last entry, its label and its table row.
;;;
;;; LABELS SIT AT THE TRUE CENTROID
;;; Not the centre of the bounding box - the actual centre of area, found by
;;; creating a temporary region and reading its centroid. On an L-shaped room
;;; the difference is the difference between a label inside the room and one
;;; floating in the corridor outside it.
;;;
;;; LIVE FIELDS
;;; With AreaSchedule:UseFields set, the table's number column references the
;;; label text and its area column references the object - so renumbering a
;;; label or stretching a boundary updates the table by itself. Picked areas
;;; get a static figure, since their traced boundary does not survive.
;;;
;;; ADDING TO AN EXISTING TABLE
;;; Press Enter instead of picking a point for the table, and you are asked to
;;; select an existing one to continue into - which is how a schedule is built
;;; up over several sessions.
;;;
;;; See the settings block for headings, prefixes, suffixes and the area
;;; conversion factor - set that to 1e-6 to schedule a millimetre drawing in
;;; square metres.
;;; ---------------------------------------------------------------------------

(vl-load-com)

;;; ---------------------------------------------------------------------------
;;; SETTINGS
;;; ---------------------------------------------------------------------------

(setq AreaSchedule:Heading    "Area Table")  ; table title
(setq AreaSchedule:NumTitle   "Number")      ; first column heading
(setq AreaSchedule:AreaTitle  "Area")        ; second column heading
(setq AreaSchedule:NumPrefix  "")            ; before each number, "" for none
(setq AreaSchedule:NumSuffix  "")            ; after each number
(setq AreaSchedule:AreaPrefix "")            ; before each area figure
(setq AreaSchedule:AreaSuffix "")            ; after each area figure
(setq AreaSchedule:Factor     1.0)           ; area conversion; 1e-6 = mm2 to m2
(setq AreaSchedule:UseFields  t)             ; live fields in the table
(setq AreaSchedule:Format     "%lu6%qf1")    ; area field formatting

;; Environment key for the remembered pick/object mode.
(setq AreaSchedule:ModeKey "YZ\\areaschedule-mode")

;;; ---------------------------------------------------------------------------
;;; SESSION STATE
;;;
;;; The running number persists between runs so a schedule continued later
;;; carries on from where it stopped rather than restarting at 1. The last
;;; output folder is likewise remembered.
;;; ---------------------------------------------------------------------------
(if (null *AreaSchedule:Number*) (setq *AreaSchedule:Number* 0))
(if (null *AreaSchedule:Folder*) (setq *AreaSchedule:Folder* ""))

;; ---------------------------------------------------------------------------
;; AreaSchedule:Doc  -  cached active document
;; ---------------------------------------------------------------------------
(defun AreaSchedule:Doc nil
    (eval (list 'defun 'AreaSchedule:Doc 'nil
                (vla-get-activedocument (vlax-get-acad-object))
          )
    )
    (AreaSchedule:Doc)
)

;; ---------------------------------------------------------------------------
;; AreaSchedule:Centroid
;; ---------------------------------------------------------------------------
;; Returns the true centre of area of a closed object, in WCS.
;;
;; A temporary REGION is created from the object purely to read its Centroid
;; property, then deleted. There is no other way to obtain a genuine centroid
;; in AutoLISP - and the bounding box centre, which is the easy alternative,
;; falls outside the shape entirely for anything L-shaped or crescent-shaped.
;; ---------------------------------------------------------------------------
(defun AreaSchedule:Centroid ( space objs / reg cen )
    (setq reg (car (vlax-invoke space 'addregion objs))
          cen (vlax-get reg 'centroid)
    )
    (vla-delete reg)
    (trans cen 1 0)
)

;; ---------------------------------------------------------------------------
;; AreaSchedule:Label
;; ---------------------------------------------------------------------------
;; Creates a centred text label at a point and returns it.
;;
;; The alignment point is set AFTER the alignment itself, because changing the
;; alignment moves the text - so writing the position first would be undone.
;; ---------------------------------------------------------------------------
(defun AreaSchedule:Label ( space point string height rotation / text )
    (setq text (vla-addtext space string (vlax-3D-point point) height))
    (vla-put-alignment text acalignmentmiddlecenter)
    (vla-put-textalignmentpoint text (vlax-3D-point point))
    (vla-put-rotation text rotation)
    text
)

;; ---------------------------------------------------------------------------
;; AreaSchedule:Open
;; ---------------------------------------------------------------------------
;; Opens a finished file in whatever application is associated with it.
;;
;; The Shell COM object is released explicitly - one left alive persists for
;; the rest of the AutoCAD session.
;; ---------------------------------------------------------------------------
(defun AreaSchedule:Open ( target / shell result )
    (if (setq shell (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application"))
        (progn
            (setq result
                (and (or (= 'int (type target)) (setq target (findfile target)))
                     (not (vl-catch-all-error-p
                              (vl-catch-all-apply 'vlax-invoke (list shell 'Open target))
                          )
                     )
                )
            )
            (vlax-release-object shell)
        )
    )
    result
)

;; ---------------------------------------------------------------------------
;; AreaSchedule:Select
;; ---------------------------------------------------------------------------
;; Prompts until the user picks something satisfying the predicate, or chooses
;; a keyword, or exits.
;;
;; Returns the entity, the keyword string, or nil - which the caller
;; distinguishes by type. Sharing one prompt loop keeps the "missed, try again"
;; handling in a single place.
;;
;; msg  - [str] prompt
;; pred - [quoted lambda] test applied to a picked entity, or nil
;; func - [sym] entsel or getpoint
;; init - [list] initget arguments for the keyword options
;; ---------------------------------------------------------------------------
(defun AreaSchedule:Select ( msg pred func init / e )
    (setq pred (eval pred))
    (while
        (progn
            (setvar 'errno 0)
            (apply 'initget init)
            (setq e (func msg))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (= 'str (type e)) nil)      ; a keyword - accept it
                (   (vl-consp e)
                    (if (and pred (not (pred (setq e (car e)))))
                        (princ "\nThat object has no area, or is not closed.")
                    )
                )
            )
        )
    )
    e
)

;; ---------------------------------------------------------------------------
;; AreaSchedule:ObjectID
;; ---------------------------------------------------------------------------
;; Returns an object's ID as a string. On 64-bit AutoCAD the value exceeds an
;; AutoLISP integer and must be fetched as a string.
;; ---------------------------------------------------------------------------
(defun AreaSchedule:ObjectID ( doc obj )
    (if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
        (vlax-invoke-method (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false)
        (itoa (vla-get-Objectid obj))
    )
)

;; ---------------------------------------------------------------------------
;; AreaSchedule:Annotative
;; ---------------------------------------------------------------------------
;; True if the named text style is annotative. The flag lives in the style's
;; extended data under "AcadAnnotative", as group 1070 with value 1.
;; ---------------------------------------------------------------------------
(defun AreaSchedule:Annotative ( style / object annotx )
    (and (setq object (tblobjname "STYLE" style))
         (setq annotx (cadr (assoc -3 (entget object '("AcadAnnotative")))))
         (= 1 (cdr (assoc 1070 (reverse annotx))))
    )
)

;; ---------------------------------------------------------------------------
;; AreaSchedule:CanLabel
;; ---------------------------------------------------------------------------
;; The test for an object that can be scheduled: it must report an area, must
;; not be a hatch, and must be closed - or be a region, which is closed by
;; definition.
;;
;; Hatches are excluded because a hatch's area is the area of its pattern
;; coverage, which is not the same as the boundary the user means, and picking
;; one is almost always a mis-click.
;; ---------------------------------------------------------------------------
(setq AreaSchedule:CanLabel
   '(lambda ( x )
        (and (vlax-property-available-p (vlax-ename->vla-object x) 'area)
             (not (= "HATCH" (cdr (assoc 0 (entget x)))))
             (or (= "REGION" (cdr (assoc 0 (entget x)))) (vlax-curve-isclosed x))
        )
    )
)

;; ---------------------------------------------------------------------------
;; AreaSchedule:Run
;; ---------------------------------------------------------------------------
;; The whole routine. Table mode when toTable is true, file mode otherwise.
;;
;; Note the original left several of its variables undeclared - the table
;; heading, the file delimiter and the Shell object among them - so those
;; leaked into the global namespace. All are localised here.
;; ---------------------------------------------------------------------------
(defun AreaSchedule:Run ( toTable / *error* vars vals acspc del el fl mode n of
                                    p1 pt st tb th ts tx ucsxang ucszdir count )

    (setq vars '("CMDECHO")
          vals (mapcar 'getvar vars)
    )

    (defun AreaSchedule:Restore ( )
        ;; The last traced boundary is temporary and must go, on every path.
        (if el (progn (entdel el) (setq el nil)))
        (if (and of (= 'file (type of))) (close of))
        (setenv AreaSchedule:ModeKey (if mode "1" "0"))
        (mapcar 'setvar vars vals)
        (while (= 8 (logand 8 (getvar 'undoctl)))
            (command "_.UNDO" "_End")
            (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        )
        (princ)
    )

    (defun *error* ( msg )
        (AreaSchedule:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** AREASCHEDULE error: " msg " **"))
        )
        (princ)
    )

    (setvar "CMDECHO" 0)
    ;; AutoCAD 2015 and later refuse (command) inside an *error* handler
    ;; unless the routine says up front that it will use one. Restore does,
    ;; to close this undo group. The declaring call is absent on older
    ;; releases, so it is wrapped rather than tested for.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")

    (setq acspc   (vlax-get-property (AreaSchedule:Doc)
                      (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))
          ;; The UCS normal and X axis rotation, so labels sit correctly in a
          ;; rotated UCS.
          ucszdir (trans '(0.0 0.0 1.0) 1 0 t)
          ucsxang (angle '(0.0 0.0 0.0) (trans (getvar 'UCSXDIR) 0 ucszdir))
          mode    (= "1" (cond ((getenv AreaSchedule:ModeKey))
                               ((setenv AreaSchedule:ModeKey "0"))
                         )
                  )
          count   0
    )

    ;; Label height. An annotative style reports its PLOTTED height, so it is
    ;; divided by the annotation scale to give the model-space size.
    (setq ts (/ (getvar 'TEXTSIZE)
                (if (AreaSchedule:Annotative (getvar 'TEXTSTYLE))
                    (cond ((getvar 'CANNOSCALEVALUE)) (1.0))
                    1.0
                )
             )
    )

    (cond
        (   (and toTable (not (vlax-method-applicable-p acspc 'addtable)))
            (princ "\nTable objects are not available in this AutoCAD version.")
        )

        (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))
            (princ "\nThe current layer is locked - unlock it before running this.")
        )

        ;; Starting number, offered as the next one on from last time.
        (   (not (setq *AreaSchedule:Number*
                     (cond
                         ((getint (strcat "\nSpecify starting number <"
                                          (itoa (setq *AreaSchedule:Number* (1+ *AreaSchedule:Number*)))
                                          ">: ")))
                         (*AreaSchedule:Number*)
                     )
                 )
            )
            (princ "\n*Cancelled*")
        )

        ;; -------------------------------------------------------------------
        ;; TABLE MODE
        ;; -------------------------------------------------------------------
        (   toTable
            ;; Row height from the table style, again undoing annotative
            ;; scaling. A style reporting zero height falls back to the text
            ;; size, since a zero-height row cannot be created.
            (setq th
                (* 2.0
                   (if (zerop (setq th (vla-gettextheight
                                           (setq st (vla-item
                                                        (vla-item (vla-get-dictionaries (AreaSchedule:Doc))
                                                                  "ACAD_TABLESTYLE")
                                                        (getvar 'CTABLESTYLE)
                                                    )
                                           )
                                           acdatarow
                                       )
                              )
                       )
                       ts
                       (/ th (if (AreaSchedule:Annotative (vla-gettextstyle st acdatarow))
                                 (cond ((getvar 'CANNOSCALEVALUE)) (1.0))
                                 1.0
                             )
                       )
                   )
                )
            )

            (if
                (cond
                    ;; A picked point creates a new table; Enter offers to add
                    ;; to an existing one.
                    (   (progn
                            (initget "Add")
                            (vl-consp (setq pt (getpoint "\nPick point for the table <add to existing>: ")))
                        )
                        (setq tb (vla-addtable acspc
                                     (vlax-3D-point (trans pt 1 0)) 2 2 th
                                     (* 0.8 th (max (strlen AreaSchedule:NumTitle)
                                                    (strlen AreaSchedule:AreaTitle)))
                                 )
                        )
                        ;; The table is aligned to the UCS X axis, so it reads
                        ;; correctly in a rotated UCS.
                        (vla-put-direction tb (vlax-3D-point (getvar 'UCSXDIR)))
                        (vla-settext tb 0 0 AreaSchedule:Heading)
                        (vla-settext tb 1 0 AreaSchedule:NumTitle)
                        (vla-settext tb 1 1 AreaSchedule:AreaTitle)
                        (setq n 1)
                        t
                    )

                    ;; Continue an existing table. It must have at least two
                    ;; columns to hold a number and an area.
                    (   (and (setq tb (AreaSchedule:Select "\nSelect the table to add to: "
                                          '(lambda ( x ) (= "ACAD_TABLE" (cdr (assoc 0 (entget x)))))
                                          entsel nil
                                      )
                             )
                             (< 1 (vla-get-columns (setq tb (vlax-ename->vla-object tb))))
                        )
                        (setq n (1- (vla-get-rows tb))
                              *AreaSchedule:Number* (1- *AreaSchedule:Number*)
                        )
                        t
                    )
                )

                (progn
                    (while
                        (progn
                            (if mode
                                (setq p1 (AreaSchedule:Select
                                             (strcat "\nSelect object [" (if tx "Undo/" "") "Pick] <exit>: ")
                                             AreaSchedule:CanLabel entsel
                                             (list (if tx "Undo Pick" "Pick"))
                                         )
                                )
                                (progn
                                    (initget (if tx "Undo Object" "Object"))
                                    (setq p1 (getpoint (strcat "\nPick inside an area ["
                                                               (if tx "Undo/" "") "Object] <exit>: ")))
                                )
                            )
                            (cond
                                ;; Undo: remove the label, the row and the number.
                                (   (and tx (= "Undo" p1))
                                    (if el (progn (entdel el) (setq el nil)))
                                    (vla-deleterows tb n 1)
                                    (vla-delete (car tx))
                                    (setq n     (1- n)
                                          tx    (cdr tx)
                                          count (1- count)
                                          *AreaSchedule:Number* (1- *AreaSchedule:Number*)
                                    )
                                    t
                                )
                                (   (= "Undo" p1)
                                    (princ "\nNothing to undo.")
                                    t
                                )
                                (   (= "Object" p1)
                                    (if el (progn (entdel el) (setq el nil)))
                                    (setq mode t)
                                    t
                                )
                                (   (= "Pick" p1)
                                    (setq mode nil)
                                    t
                                )

                                ;; An existing object was selected. Both columns
                                ;; can be live fields, since the object persists.
                                (   (and mode (= 'ename (type p1)))
                                    (setq tx (cons (AreaSchedule:Label acspc
                                                       (AreaSchedule:Centroid acspc
                                                           (list (setq p1 (vlax-ename->vla-object p1))))
                                                       (strcat AreaSchedule:NumPrefix
                                                               (itoa (setq *AreaSchedule:Number*
                                                                           (1+ *AreaSchedule:Number*)))
                                                               AreaSchedule:NumSuffix)
                                                       ts ucsxang
                                                   )
                                                   tx
                                             )
                                    )
                                    (vla-insertrows tb (setq n (1+ n)) th 1)
                                    (vla-settext tb n 1
                                        (if AreaSchedule:UseFields
                                            (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                                                    (AreaSchedule:ObjectID (AreaSchedule:Doc) p1)
                                                    ">%).Area \\f \"" AreaSchedule:Format "\">%")
                                            (strcat AreaSchedule:AreaPrefix
                                                    (rtos (* AreaSchedule:Factor (vla-get-area p1)) 2)
                                                    AreaSchedule:AreaSuffix)
                                        )
                                    )
                                    (vla-settext tb n 0
                                        (if AreaSchedule:UseFields
                                            (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                                                    (AreaSchedule:ObjectID (AreaSchedule:Doc) (car tx))
                                                    ">%).TextString>%")
                                            (strcat AreaSchedule:NumPrefix (itoa *AreaSchedule:Number*)
                                                    AreaSchedule:NumSuffix)
                                        )
                                    )
                                    (setq count (1+ count))
                                    t
                                )

                                ;; A point was picked - trace the boundary.
                                ;; The area is written as a STATIC figure, since
                                ;; the traced boundary is deleted afterwards and
                                ;; a field referencing it would break.
                                (   (vl-consp p1)
                                    (if el (progn (entdel el) (setq el nil)))
                                    (setq el (entlast))
                                    (vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" p1 "")

                                    (if (not (equal el (setq el (entlast))))
                                        (progn
                                            (setq tx (cons (AreaSchedule:Label acspc
                                                               (AreaSchedule:Centroid acspc
                                                                   (list (vlax-ename->vla-object el)))
                                                               (strcat AreaSchedule:NumPrefix
                                                                       (itoa (setq *AreaSchedule:Number*
                                                                                   (1+ *AreaSchedule:Number*)))
                                                                       AreaSchedule:NumSuffix)
                                                               ts ucsxang
                                                           )
                                                           tx
                                                     )
                                            )
                                            (vla-insertrows tb (setq n (1+ n)) th 1)
                                            (vla-settext tb n 1
                                                (strcat AreaSchedule:AreaPrefix
                                                        (rtos (* AreaSchedule:Factor (vlax-curve-getarea el)) 2)
                                                        AreaSchedule:AreaSuffix)
                                            )
                                            (vla-settext tb n 0
                                                (if AreaSchedule:UseFields
                                                    (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                                                            (AreaSchedule:ObjectID (AreaSchedule:Doc) (car tx))
                                                            ">%).TextString>%")
                                                    (strcat AreaSchedule:NumPrefix (itoa *AreaSchedule:Number*)
                                                            AreaSchedule:NumSuffix)
                                                )
                                            )
                                            ;; Highlight the traced boundary so
                                            ;; the user can see what was measured.
                                            (redraw el 3)
                                            (setq count (1+ count))
                                        )
                                        (princ "\nNo enclosed area was found at that point.")
                                    )
                                    t
                                )
                            )
                        )
                    )
                    (if el (progn (entdel el) (setq el nil)))
                    (princ (strcat "\n" (itoa count) " area"
                                   (if (= 1 count) "" "s") " scheduled."))
                )
                (princ "\n*Cancelled*")
            )
        )

        ;; -------------------------------------------------------------------
        ;; FILE MODE
        ;; -------------------------------------------------------------------
        (   (and (setq fl (getfiled "Create Output File" *AreaSchedule:Folder* "txt;csv;xls" 1))
                 (setq of (open fl "w"))
            )
            ;; The delimiter follows the extension: comma for CSV, tab for the
            ;; two formats a spreadsheet reads as tab-separated.
            (setq *AreaSchedule:Folder* (vl-filename-directory fl)
                  del (cdr (assoc (strcase (vl-filename-extension fl) t)
                                 '((".txt" . "\t") (".csv" . ",") (".xls" . "\t"))
                           )
                      )
                  *AreaSchedule:Number* (1- *AreaSchedule:Number*)
            )

            (write-line AreaSchedule:Heading of)
            (write-line (strcat AreaSchedule:NumTitle del AreaSchedule:AreaTitle) of)

            (while
                (progn
                    (if mode
                        (setq p1 (AreaSchedule:Select "\nSelect object [Pick] <exit>: "
                                     AreaSchedule:CanLabel entsel '("Pick")
                                 )
                        )
                        (progn
                            (initget "Object")
                            (setq p1 (getpoint "\nPick inside an area [Object] <exit>: "))
                        )
                    )
                    (cond
                        (   (= "Object" p1)
                            (if el (progn (entdel el) (setq el nil)))
                            (setq mode t)
                            t
                        )
                        (   (= "Pick" p1)
                            (setq mode nil)
                            t
                        )

                        (   (= 'ename (type p1))
                            (AreaSchedule:Label acspc
                                (AreaSchedule:Centroid acspc
                                    (list (setq p1 (vlax-ename->vla-object p1))))
                                (strcat AreaSchedule:NumPrefix
                                        (itoa (setq *AreaSchedule:Number* (1+ *AreaSchedule:Number*)))
                                        AreaSchedule:NumSuffix)
                                ts ucsxang
                            )
                            (write-line
                                (strcat AreaSchedule:NumPrefix (itoa *AreaSchedule:Number*)
                                        AreaSchedule:NumSuffix del
                                        AreaSchedule:AreaPrefix
                                        (rtos (* AreaSchedule:Factor (vla-get-area p1)) 2)
                                        AreaSchedule:AreaSuffix)
                                of
                            )
                            (setq count (1+ count))
                            t
                        )

                        (   (vl-consp p1)
                            (if el (progn (entdel el) (setq el nil)))
                            (setq el (entlast))
                            (vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" p1 "")

                            (if (not (equal el (setq el (entlast))))
                                (progn
                                    (AreaSchedule:Label acspc
                                        (AreaSchedule:Centroid acspc (list (vlax-ename->vla-object el)))
                                        (strcat AreaSchedule:NumPrefix
                                                (itoa (setq *AreaSchedule:Number* (1+ *AreaSchedule:Number*)))
                                                AreaSchedule:NumSuffix)
                                        ts ucsxang
                                    )
                                    (write-line
                                        (strcat AreaSchedule:NumPrefix (itoa *AreaSchedule:Number*)
                                                AreaSchedule:NumSuffix del
                                                AreaSchedule:AreaPrefix
                                                (rtos (* AreaSchedule:Factor (vlax-curve-getarea el)) 2)
                                                AreaSchedule:AreaSuffix)
                                        of
                                    )
                                    (redraw el 3)
                                    (setq count (1+ count))
                                )
                                (princ "\nNo enclosed area was found at that point.")
                            )
                            t
                        )
                    )
                )
            )

            (if el (progn (entdel el) (setq el nil)))
            (setq of (close of))
            (AreaSchedule:Open (findfile fl))
            (princ (strcat "\n" (itoa count) " area" (if (= 1 count) "" "s")
                           " written to " fl))
        )

        (   t
            (princ "\n*Cancelled*")
        )
    )

    (AreaSchedule:Restore)
    (princ)
)

;; ---------------------------------------------------------------------------
;; Commands
;; ---------------------------------------------------------------------------
;; The original named these AT and AF. Renamed to say what they do - and
;; because AF collided with a command of the same name in the length and area
;; field routine.
;; ---------------------------------------------------------------------------
(defun c:AREATABLE nil (AreaSchedule:Run   t))   ; schedule into an AutoCAD table
(defun c:AREAFILE  nil (AreaSchedule:Run nil))   ; schedule out to a file

(princ)