Bounding Box для объектов

;;; http://www.theswamp.org/index.php?topic=30660.0
;;; Entsel/NEntsel with display of layer name of object on mouse over and optional keyword
;;; #Nested - T for nested selection, nil if not
;;; #Prompt - Prompt string to display, when not displaying object's layer name
;;; #Keywords - Comma delimited key letters or nil to ignore (ie: "A,b" to match A, a, B or b
;;; Alan J. Thompson, 10.20.09
;;; 10.29.09 CAB modified
(defun AT:EntselLayerDisplay
       (#Nested #Prompt #Keywords / *error* #Layer #Prompt #Text #Read #Temp #Final MinPt MaxPt tStr)
  (setq *error* (lambda (x) (and #Text (vl-catch-all-apply 'vla-delete (list #Text))))
        #Layer  (vlax-ename->vla-object (tblobjname "layer" "0"))
  ) ;_ setq
  (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
  (or #Prompt (setq #Prompt "Select object: "))
  (or (eq (getvar 'clayer) "0") (vla-put-freeze #Layer :vlax-false))
  (vla-put-lock #Layer :vlax-false)
  (vla-put-layeron #Layer :vlax-true)
  (setq #Text (vlax-ename->vla-object
                (entmakex (list '(0 . "MTEXT")
                                '(100 . "AcDbEntity")
                                '(100 . "AcDbMText")
                                '(8 . "0")
                                ;'(62 . 250) ; CAB removed
                                ;'(90 . 1)   ; CAB removed no workie in ACAD2000
                                ;'(63 . 7)   ; CAB removed no workie in ACAD2000
                                ;'(45 . 1.3) ; CAB removed no workie in ACAD2000
                                (cons 40 (* (getvar "viewsize") 0.013))
                                (cons 50 0.0)
                                '(10 0 0 0);(trans (cadr (grread T 15 0)) 1 0)) ; CAB modified
                          ) ;_ list
                ) ;_ entmakex
              ) ;_ vlax-ename->vla-object
  ) ;_ setq
  (vl-catch-all-apply
    '(lambda ()
       (vlax-invoke
         (vla-AddObject
           (vla-GetExtensionDictionary
             (if (or (eq acmodelspace (vla-get-activespace *AcadDoc*))
                     (eq :vlax-true (vla-get-mspace *AcadDoc*))
                 ) ;_ or
               (vla-get-modelspace *AcadDoc*)
               (vla-get-paperspace *AcadDoc*)
             ) ;_ if
           ) ;_ vla-GetExtensionDictionary
           "ACAD_SORTENTS"
           "AcDbSortentsTable"
         ) ;_ vla-AddObject
         'MoveToTop
         (list #Text)
       ) ;_ vlax-invoke
     ) ;_ lambda
  ) ;_ vl-catch-all-apply
  (while (and (setq #Read (grread T 15 2))
              (/= (cadr #Read) 13)
              (/= (car #Read) 25)
              (not (vl-position (cadr #Read) '(13 158)))
              (not #Final)
         ) ;_ and
    (cond
      ((and (eq (car #Read) 2)(eq 9 (cadr #Read)));Click <TAB> to toggle between nested and non-nested
       (setq #Nested (not #Nested))
       )  
      ((eq 5 (car #Read))
       (vla-put-insertionpoint
         #Text
         (vlax-3d-point (polar (trans (cadr #Read) 1 0)
                               (angle '(0 0) (trans (getvar "UCSXDIR") 0 (trans '(0 0 1) 1 0 T))) ; CAB modified
                               (* (getvar "viewsize") 0.02)))
       ) ;_ vla-put-insertionpoint
       (vla-put-height #Text (* (getvar "viewsize") 0.013))
       (if (setq #Ent (nentselp (cadr #Read)))
         (if #Nested
       (progn
         (setq QQQ #Ent)
            (vla-GetBoundingBox (vlax-ename->vla-object  (car #Ent)) 'MinPt 'MaxPt)
           (setq MinPt (vlax-safearray->list MinPt) MaxPt (vlax-safearray->list MaxPt))
           (setq tStr
                  (strcat
                    "{\\C4;"         (cdr (assoc 0 (entget (car #Ent)))) "}"
                    "\nHEIGHT:  "     (rtos (abs(- (cadr MaxPt)(cadr MinPt))) 2 5)
            "\nWIDTH:  "     (rtos (abs(- (car MaxPt)(car MinPt))) 2 5)
                    "\nLAYER:  "     (cdr (assoc 8 (entget (car #Ent))))                  )
                )
           (vla-put-textstring #Text tStr)
       )
           (cond
             ((eq (length #Ent) 2) (vla-put-textstring #Text (cdr (assoc 8 (entget (car #Ent))))))
             ((eq (length #Ent) 4)
              (vla-put-textstring #Text (cdr (assoc 8 (entget (car (car (reverse #Ent)))))))
             )
           ) ;_ cond
         ) ;_ if
         (vla-put-textstring #Text #Prompt)
       ) ;_ if
      )
      ((eq 3 (car #Read))
       (if (setq #Temp (nentselp (cadr #Read)))
         (progn
           (or #Nested
               (and (eq 4 (length #Temp))
                    (setq #Temp (list (car (car (reverse #Temp))) (cadr #Temp)))
               ) ;_ and
           ) ;_ or
           (or (eq (vla-get-objectid (vlax-ename->vla-object (car #Temp)))
                   (vla-get-objectid #Text)
               ) ;_ eq
               (setq #Final #Temp)
           ) ;_ or
         ) ;_ progn
       ) ;_ if
      )
      ((and #Keywords (eq (car #Read) 2))
       (if (wcmatch (strcase (chr (cadr #Read))) (strcase #Keywords))
         (setq #Final (chr (cadr #Read)))
       ) ;_ if
      )
    ) ;_ cond
  ) ;_ while
  (*error* nil)
  #Final
) ;_ defun
(defun C:TTT ()(AT:EntselLayerDisplay T NIL NIL))
(princ "\nType TTT in command line")