;;----------------=={ Display Field Objects }==---------------;;
;;                                                            ;;
;;  Prompts user to select a field linked to one or more      ;;
;;  objects, then displays which objects are linked to the    ;;
;;  selected field.                                           ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Version 1.0    -    04-11-2011                            ;;
;;------------------------------------------------------------;;

(defun c:FieldObjects

    (
        /
        *error*
        _corners->list
        _offsetoutside
        _midpoint
        _inters-box-point
        _outline
        _getfieldobjects
        _selectif

        a b c d e
    )

    (defun *error* ( m ) (redraw) (princ))

    (defun _corners->list ( a b )
        (mapcar
            (function
                (lambda ( a b ) (list (car a) (cadr b)))
            )
            (list a b b a) (list a a b b)
        )
    )

    (defun _offsetoutside ( a b )
        (mapcar
            (function
                (lambda ( a c )
                    (mapcar
                        (function
                            (lambda ( a c ) ((eval a) c b))
                        )
                        a c
                    )
                )
            )
           '((- -) (+ -) (+ +) (- +)) a
        )
    )

    (defun _midpoint ( a b )
        (mapcar
            (function
                (lambda ( a b ) (/ (+ a b) 2.))
            )
            a b
        )
    )

    (defun _inters-box-point ( a b c )
        (vl-some
            (function
                (lambda ( d e ) (inters b c d e))
            )
            a (cons (last a) a)
        )
    )

    (defun _outline ( a b c d e / f g )
        (mapcar
            (function
                (lambda ( a b ) (grdraw a b e 1))
            )
            a (cons (last a) a)
        )
        (if
            (and c
                (setq f (_inters-box-point a b d))
                (setq g (_inters-box-point c d b))
            )
            (grdraw f g 2 1)
        )
    )

    (defun _getfieldobjects ( a / __getfieldobjects )

        (defun __getfieldobjects ( a )
            (apply 'append
                (mapcar
                    (function
                        (lambda ( b )
                            (if (= 360 (car b))
                                (__getfieldobjects (cdr b))
                                (if (= 331 (car b)) (list (cdr b)))
                            )
                        )
                    )
                    (entget a)
                )
            )
        )
        
        (if
            (and
                (wcmatch (cdr (assoc 0 (setq a (entget a)))) "TEXT,MTEXT,ATTRIB")
                (setq a (cdr (assoc 360 a)))
                (setq a (dictsearch a "ACAD_FIELD"))
                (setq a (dictsearch (cdr (assoc -1 a)) "TEXT"))
                (setq a (cdr (assoc 360 a)))
            )
            (__getfieldobjects a)
        )
    )

    (defun _selectif ( a b / c d ) (setq b (eval b))
        (while
            (progn (setvar 'ERRNO 0) (setq c (car (nentsel a)))
                (cond
                    (   (= 7 (getvar 'ERRNO))
                        (princ "\nMissed, try again.")
                    )
                    (   (eq 'ENAME (type c))
                        (if (not (setq d (b c))) (princ "\nInvalid Object."))
                    )
                )
            )
        )
        (if c (cons c d))
    )

    (if
        (setq a
            (mapcar
                (function
                    (lambda ( a )
                        (vla-getboundingbox (vlax-ename->vla-object a) 'b 'c)
                        (setq b (vlax-safearray->list b)
                              c (vlax-safearray->list c)
                        )
                        (list (_corners->list b c) (_midpoint b c))
                    )
                )
                (_selectif "\nSelect Field: " '_getfieldobjects)
            )
        )
        (progn
            (princ "\nPress any key to Exit...")
            (while (= 5 (car (setq b (grread t 9))))
                (redraw)
                (_outline
                    (setq c (cadar a)
                          d (_offsetoutside (caar a) (/ (getvar 'VIEWSIZE) 50.))
                    )
                    nil nil nil 3
                )
                (foreach e (cdr a)
                    (_outline (_offsetoutside (car e) (/ (getvar 'VIEWSIZE) 50.)) (cadr e) d c 1)
                )
                
            )
        )
    )
    (redraw) (princ)
)