TEXTBOX_v1_00.................................................free

Command: TEXTBOX

This function draws a rectangle around the TEXT and MTEXT objects regardles of their orientation. For MTEXT objects with complex formatting results may not be precise.

 

Code:

;;; ================================================
;;;        TEXTBOXv1_00.LSP     
;;;
;;;        Written by Andrzej Kalinowski,     www.autolisps.blogspot.com
;;;        v1.00 - 18.10.2021 - first release
;;;
;;;        Command: TEXTBOX
;;;                This function draws a rectangle around the TEXT and MTEXT objects regardles of their orientation.
;;;                For MTEXT objects with complex formatting results may not be precise
;;;  
;;; ================================================
(defun c:TEXTBOX ( /  obj1 obj2 plinOb Wi1 Hi1 Jst1 ActSpc PtSfArr PtsLst )
    (setq obj1 (car(entsel "\nselect MTEXT or TEXT: ")))
    (if (= (vla-get-lock (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object) ) ) (cdr (assoc 8 (entget obj1))) ) ) :vlax-true );check if object is on a locked layer
        (progn (alert (strcat "Selected object is on a locked layer. \nYou have to unlock it first.")) (exit) )
    );if
    (if (/= (getvar "BLOCKEDITOR") 1)  (vl-cmdf "_ucs" "_w") )
    (if (= "MTEXT" (cdr (assoc 0 (entget obj1))))

        (progn ;MTEXT
            (setq Wi1  (cdr (assoc 42 (entget obj1))))
            (setq Jst1 (cdr (assoc 71 (entget obj1)) ));JUSTIFICATION
            ;1- top left    2-top center    3-top right    4-middle left    5-middle center    6-middle right    7-bottom left    8-bottom center    9- bottom right
            (if (member (cdr (assoc 72 (entget obj1))) (list 1 5));drawing direction :  (1)horizontal, (5) by style 
                (setq Hi1  (cdr (assoc 43 (entget obj1))))
                (setq Hi1  (* -1 (cdr (assoc 40 (entget obj1)))));ELSE drawing direction :  (3)vertical
            );if
            (cond ;JUSTIFICATION
                ((= Jst1 1)    (setq PtsLst    (list    0.0 0.0        Wi1 0.0        Wi1 (* Hi1 -1)        0.0 (* Hi1 -1)    )) )
                ((= Jst1 2)    (setq PtsLst    (list    (* Wi1 -0.5) 0.0        (/ Wi1 2) 0.0        (/ Wi1 2) (* Hi1 -1)        (* Wi1 -0.5) (* Hi1 -1)    )) )
                ((= Jst1 3)    (setq PtsLst    (list    (* -1 Wi1 ) 0.0        0.0 0.0        0.0 (* Hi1 -1)        (* -1 Wi1 ) (* Hi1 -1)    ))    )
                ((= Jst1 4)    (setq PtsLst    (list    0.0 (* Hi1 0.5)        Wi1 (* Hi1 0.5)        Wi1 (* Hi1 -0.5)        0.0 (* Hi1 -0.5)    ))    )
                ((= Jst1 5)    (setq PtsLst    (list    (* Wi1 -0.5) (* Hi1 0.5)        (* Wi1 0.5) (* Hi1 0.5)        (* Wi1 0.5) (* Hi1 -0.5)        (* Wi1 -0.5) (* Hi1 -0.5)    ))    )
                ((= Jst1 6)    (setq PtsLst    (list    (* Wi1 -1) (* Hi1 0.5)        0.0 (* Hi1 0.5)        0.0 (* Hi1 -0.5)        (* Wi1 -1) (* Hi1 -0.5)    ))    )
                ((= Jst1 7)    (setq PtsLst    (list    0.0 0.0        Wi1 0.0        Wi1 Hi1        0.0 Hi1    ))    )
                ((= Jst1 8)    (setq PtsLst    (list    (* Wi1 -0.5) 0.0        (/ Wi1 2) 0.0        (/ Wi1 2) Hi1        (* Wi1 -0.5) Hi1    ))    )
                ((= Jst1 9)    (setq PtsLst    (list    (* -1 Wi1 ) 0.0        0.0 0.0        0.0 Hi1        (* -1 Wi1 ) Hi1    ))    )
            );cond
        );progn

        (progn ;TEXT
            ;0-left    1-center    2-right    3-aligned    4-middle    5-5fit    6-top left    7-top center    8-top right    9-middle left    10-middle center    11-middle right     12-bottom left    13-bottom center    14-bottom right
            (if (not(member (vla-get-alignment (vlax-ename->vla-object obj1)) (list 3 5)))
                (progn
                    (setq Wi1  (textbox (entget obj1))) ; ((1.29014 -4.03167 0) (206.858 13.9069 0))
                    (setq PtsLst    (list    (caar  Wi1) (cadar  Wi1) (caadr Wi1) (cadar  Wi1) (caadr Wi1) (cadadr Wi1) (caar  Wi1) (cadadr Wi1)    )    )
                );progn
                (progn ; Aligneed or Fit
                    (setq obj2 (vla-copy (vlax-ename->vla-object obj1) ) )
                    (vla-move obj2 (vlax-3D-point (vlax-get obj2 'insertionpoint) ) (vlax-3D-point (list 0 0 0) ) )
                    (vla-put-normal obj2 (vlax-3D-point (list 0 0 1)))
                    (vla-rotate obj2 (vlax-3D-point (list 0 0 0) ) (* -1 (vla-get-rotation obj2) ) )
                    (setq Wi1  (textbox (entget (vlax-vla-object->ename obj2)))) ; ((1.29014 -4.03167 0) (206.858 13.9069 0))
                    (vla-delete obj2)
                    (setq PtsLst    (list    (caar  Wi1) (cadar  Wi1) (caadr Wi1) (cadar  Wi1) (caadr Wi1) (cadadr Wi1) (caar  Wi1) (cadadr Wi1)    )    )
                );progn
            );if
        );progn
    );if

    (if (= 1 (getvar "Tilemode"))
        (setq ActSpc (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) );setq
        (setq ActSpc (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object))) );setq
    );if
    (setq PtSfArr (vlax-make-safearray vlax-vbDouble (cons 0 (- (length PtsLst) 1) ) ) );makes a safearray
    (vlax-safearray-fill PtSfArr PtsLst ) ;filling safearray
    (setq plinOb (vla-addlightweightpolyline ActSpc PtSfArr))
    (vla-put-closed plinOb :vlax-true);close polyline
    (vla-rotate plinOb (vlax-3D-point (list 0.0 0.0 0.0) ) (vla-get-rotation (vlax-ename->vla-object obj1)))
    (vla-put-normal plinOb (vla-get-normal (vlax-ename->vla-object obj1)))
    (vla-move plinOb (vlax-3D-point (list 0.0 0.0 0.0) ) (vla-get-insertionpoint (vlax-ename->vla-object obj1)) )
    (if (/= (getvar "BLOCKEDITOR") 1)  (vl-cmdf "_ucs" "_p") )
    (princ)
);defun

Example:





Version history:
1.00 - 28.10.2021 - first release


File format:
.FAS


Compatibility:
-All Autocad
versions

Downlad file:
TEXTBOX_v1_00.FAS

No comments:

Post a Comment