Label Object Data in AutoCAD objects imported from GIS

If you are careful about how you MAPIMPORT GIS shape files into AutoCAD, they will come in with Object Data from their GIS data.  This object data can be seen in the AutoCAD Properties palette.  Here is a quick LISP routine I wrote to label objects with the data that is attached to them.

;;; 2016 Thomas Gail Haws GPL V3 license
;;; Namespace HAWS-
;;; Options:
;;; Include table name in label: T or nil
(defun haws-adedtt-include-table-name-in-label-p () T)
;;; Include field name in label: T or nil
(defun haws-adedtt-include-field-name-in-label-p () T)

(defun c:adedtt () (c:haws-adedatatotext))
(defun c:haws-adedatatotext (/ ssobjects datafieldlist)
  (haws-adedtt-get-objects)
  (haws-adedtt-get-user-field-list)
  (haws-adedtt-label-objects)
)

(defun haws-adedtt-get-objects (/)
  (setq ssobjects (ssget '((0 . "POLYLINE,LWPOLYLINE"))))
)

;; Get the list of fields the user wants to see
(defun haws-adedtt-get-user-field-list (/ f)
  (setq datafieldlist (haws-adedtt-get-object-field-list))
)

(defun haws-adedtt-get-object-field-list
       (/ FIELD-LIST table-list TABLE-NAMES TABLEDEF)
  (setq table-names (ade_odgettables (ssname ssobjects 0)))
  (foreach table-name table-names
    (setq tabledef (ade_odtabledefn table-name))
    (foreach field (cdr (assoc "Columns" tabledef))
      (setq table-list (cons (cdr (assoc "ColName" field)) table-list))
    )
    (setq table-list (cons table-name (list (reverse table-list))))
    (setq field-list (cons table-list field-list))
  )
  (reverse field-list)
)

(defun haws-adedtt-label-objects (/ EN I)
  (setq i -1)
  (while (setq en (ssname ssobjects (setq i (1+ i))))
    (haws-adedtt-label-object en)
  )
)

(defun haws-adedtt-label-object
       (en / LABEL-POSITION LABEL-TEXT ptlabel)
  (setq label-text (haws-adedtt-get-label-text en))
  (cond
    ((/= label-text "")
     (setq label-position (haws-adedtt-get-label-position en))
     (haws-adedtt-add-text label-position label-text)
    )
  )
)

(defun haws-adedtt-get-label-text (en / field label table)
  (setq label "")
  (foreach table datafieldlist
    (foreach field (cadr table)
      (haws-adedtt-add-field-to-label)
    )
  )
)

(defun haws-adedtt-add-field-to-label (/ data)
  (cond
    ((setq
       data
(ade_odgetfield en (car table) field 0)
     )
     (setq
       label
(strcat
 label
 "\n"
 (cond ((haws-adedtt-include-table-name-in-label-p)
(strcat (car table) ": ")
)
(T "")
 )
 (cond ((haws-adedtt-include-field-name-in-label-p)
(strcat field ": ")
)
(T "")
 )
 (vl-princ-to-string data)
)
     )
    )
  )
)

(defun haws-adedtt-get-label-position (en)
  (cond
    ((haws-adedtt-closed-polyline-p en)
     (haws-adedtt-get-centroid-position en)
    )
    (T
     (haws-adedtt-get-middle-position en)
    )
  )
)

(defun haws-adedtt-closed-polyline-p (en)
  (= 1 (logand 1 (cdr (assoc 70 (entget en)))))
)

(defun haws-adedtt-get-centroid-position (en / CENTROID-POINT OBJ)
  (command "._region" en "")
  (setq en (entlast))
  (setq obj (vlax-ename->vla-object en))
  (setq centroid-point
(vlax-safearray->list
  (vlax-variant-value (vla-get-centroid obj))
)
  )
  (command "._undo" "")
  (list centroid-point)
)

(defun haws-adedtt-get-middle-position
       (en / MIDDLE-POINT POLYLINE-LENGTH)
  (setq polyline-length
(vlax-curve-getDistAtParam
  en
  (vlax-curve-getEndParam en)
)
  )
  (command "._measure" en (/ polyline-length 1.999))
  (setq en (entlast))
  (setq middle-point (cdr (assoc 10 (entget en))))
  (command "._undo" "1")
  (list middle-point)
)

(defun haws-adedtt-add-text (label-position label-text)
  (cond
    (label-text
     (command
       "._mtext"
       (car label-position)
       "_justify"
       "_mc"
       "_width"
       "0"
       label-text
       ""
     )
    )
  )

)