1. (defun C:TBX(/ al-selectonscreen gettextbox myobj objcoll ptlst tmp)
    2.     (defun al-selectonscreen(lst / dxflst filter_code filter_value newset ssets thisdrawing)
    3.         (vl-load-com)
    4.         (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
    5.         (setq ssets (vla-get-selectionsets thisdrawing))
    6.         (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list ssets "SS1")))
    7.             (setq newSet (vla-add ssets "SS1"))
    8.             (progn
    9.                 (vla-delete (vla-item ssets "SS1"))
    10.                 (setq newSet (vla-add ssets "SS1"))
    11.             )
    12.         )
    13.         (setq dxflst (list (mapcar 'car lst) (mapcar 'cdr lst)))
    14.         (setq filter_code (vlax-make-safearray vlax-vbinteger (cons 0 (- (length (car dxflst)) 1))))
    15.         (setq filter_value (vlax-make-safearray vlax-vbvariant (cons 0  (- (length (cadr dxflst)) 1))))
    16.         (vlax-safearray-fill filter_code (car dxflst))
    17.         (vlax-safearray-fill filter_value (cadr dxflst))
    18.         (vla-selectOnScreen newSet filter_code filter_value)
    19.         newSet
    20.     )
    21.     (defun getTextBox (en / b enx h j l n o r w)
    22.         (cond
    23.             ((= 'VLA-OBJECT (type en)) (setq enx (entget (vlax-vla-object->ename en))))    
    24.             ((= 'ename (type en)) (setq enx (entget en)))    
    25.             ((= 'list (type en)) (setq enx en))
    26.         )  
    27.         (setq l 
    28.             (cond
    29.                 ((= "TEXT" (cdr (assoc 0 enx)))
    30.                     (setq
    31.                         b (cdr (assoc 10 enx))
    32.                         r (cdr (assoc 50 enx))    
    33.                         l (textbox enx)      
    34.                         n (cdr (assoc 210 enx))    
    35.                     )
    36.                     (list
    37.                         (list (caar l) (cadar l))    
    38.                         (list (caadr l) (cadar l))
    39.                         (list (caadr l) (cadadr l))
    40.                         (list (caar l) (cadadr l))
    41.                     )
    42.                 )
    43.                 ((= "MTEXT" (cdr (assoc 0 enx)))
    44.                     (setq
    45.                         n (cdr (assoc 210 enx))
    46.                         b (trans (cdr (assoc 10 enx)) 0 n)
    47.                         r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n))
    48.                         w (cdr (assoc 42 enx))
    49.                         h (cdr (assoc 43 enx))
    50.                         j (cdr (assoc 71 enx))
    51.                         o (list
    52.                                 (cond
    53.                                     ((member j '(2 5 8)) (/ w -2.0))
    54.                                     ((member j '(3 6 9)) (- w))
    55.                                     (0.0)
    56.                                 )
    57.                                 (cond
    58.                                     ((member j '(1 2 3)) (- h))
    59.                                     ((member j '(4 5 6)) (/ h -2.0))
    60.                                     (0.0)
    62.                                 )
    63.                             )
    64.                     )
    65.                     (list
    66.                         (list (car o) (cadr o))
    67.                         (list (+ (car o) w) (cadr o))
    68.                         (list (+ (car o) w) (+ (cadr o) h))
    69.                         (list (car o) (+ (cadr o) h))
    70.                     )
    71.                 )
    72.             )
    73.         )
    74.         (setq l 
    75.             (
    76.                 (lambda (m)
    77.                     (mapcar
    78.                         '(lambda (p)
    79.                              (mapcar '+(mapcar '(lambda (r) (apply '+ (mapcar '* r p))) m) b)
    80.                          )
    81.                         l
    82.                     )
    83.                 )
    84.                 (list
    85.                     (list (cos r) (sin (- r)) 0.0)
    86.                     (list (sin r) (cos r) 0.0)
    87.                     '(0.0 0.0 1.0)
    88.                 )
    89.             )
    90.         )
    91.         (mapcar '(lambda (x) (trans x n 0)) l)
    92.     )
    95.     (if (> (vla-get-Count (setq objcoll (al-selectonscreen '((0 . "*TEXT"))))) 0)    
    96.         (vlax-for obj objcoll
    97.             (setq ptlst (apply 'append (getTextBox obj)))
    98.             (setq tmp (vlax-make-safearray vlax-vbDouble (cons 0 (- (length ptlst) 1))))
    99.             (vlax-safearray-fill tmp ptlst)
    100.             (setq myobj (vla-addPolyline (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) tmp))
    101.             (vla-put-Closed myobj -1)
    102.         )
    103.     )
    105. )