Code:
;TM9.lsp
;This routine will set a background color fill to all selected text,
;mtext and dimensions, will update dimensions to current Dimstyle with
;Dimtfill set to 1 temporarily for this purpose, so works for current
;Dimscale only, text objects will be converted to mtext with width=0
;It will bring objects in layer 'Dims' to front at the end
;
; Some part of code from Tom Beauford, from AUGI
;http://forums.augi.com/showthread.php?t=77962
; Turns Background mask on text, mtext and dimensions
; Set 'Border Offset Factor' to 1.15
(vl-load-com)
(defun c:tm9 (/ ss1 num cnt obj ent)
(setvar "dimtfill" 1)
(W0)
(ttm2)
(prompt "\nSelect all text to apply the background fill...: ")
(setq ss1 (ssget '((0 . "mtext")))
num (sslength ss1)
cnt 0)
(repeat num
(setq obj (vlax-ename->vla-object (ssname ss1 cnt)))
(vlax-put-property obj 'BackgroundFill :vlax-true)
(setq ent (vlax-vla-object->ename obj)
elist (entget ent)
elist (subst (cons 45 1.15)(assoc 45 elist) elist)
elist (subst (cons 421 256)(assoc 421 elist) elist)
)
(entmod elist)
(setq cnt (1+ cnt))
); repeat
(setq sel1 (ssget "x" '((8 . "Dims,G-Dims,M-Dims,E-Dims,S-Dims,P-Dims"))))
(setq sel2 (ssget "x" '((0 . "*Dimension*"))))
(setq sel3 (ssget "x" '((0 . "*Dimension*"))))
(vl-cmdf "_dimstyle" "apply" sel2 "")
(vl-cmdf "_draworder" sel3 "" "f")
(vl-cmdf "_draworder" ss1 "" "f")
(vl-cmdf "_draworder" sel1 "" "f")
(princ)
)
;;Using code from robierzogg from HISPACAD
;;http://www.hispacad.com/foro/viewtopic.php?p=142823&sid=b23c3147d2a06a29d1dfd60078f79c08
;;;This routine works only if Express tools are installed
;;; Convert selected text into Mtext
(defun ttm2 (/ conj n nombre_n pto_insercion nombre_n1 nuevlista)
(prompt "\nSelect all text and dimensions...: ")
(SETQ conj (ssget '((0 . "TEXT"))) )
(setq n 0)
(REPEAT (sslength conj)
(setq nombre_n (ssname conj n))
;Hallamos el punto de inserción
(setq pto_insercion (assoc 10 (entget nombre_n)))
;Convert Text to Mtext, using the EXPRESS command
(command "txt2mtxt" nombre_n "")
;We set their original insertion point
(setq nombre_n1 (entlast))
(SETQ nuevlista (SUBST pto_insercion (ASSOC 10 (ENTGET nombre_n1))(ENTGET nombre_n1)))
(ENTMOD nuevlista)
(SETQ nuevlista (SUBST '(71 . 7) (ASSOC 71 (ENTGET nombre_n1))(ENTGET nombre_n1)))
(ENTMOD nuevlista)
(setq n (1+ n))
)
)
;set width for mtext to zero and defined height to zero
;Alan J. Thompson
;http://www.cadtutor.net/forum/showthread.php?t=25412
(defun W0 (/ tmp ss lst EntData)
(princ "\nSelect all converted text to remove previously assigned width..: ")
(setq ss (ssget '((0 . "MTEXT"))))
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(mapcar '(lambda (x)
(setq EntData (entget x))
(setq tmp (subst (cons 46 0.0) (assoc 46 EntData) EntData))
(entmod (subst (cons 41 0.0) (assoc 41 EntData) tmp))
)
lst
)
; (command ".regen")
(princ)
)
Weell,
Code:
;;; ;BA.lsp -BACKGROUND FILL ALL-
;;; ;Made for M3 Mexicana. December 2009
;;; ;This routine will set a background color fill to all selected text,
;;; ;mtext and dimensions, it will update dimensions to current Dimstyle with
;;; ;Dimtfill set to 1 temporarily for this purpose, so it works for current
;;; ;Dimscale only, text objects will be converted to mtext with width=0
;;; ;It will bring objects in layer 'Dims' to front at the end
;;; ;Reviewed and modified by: Alan J. Thompson.
;;;
;;; ; Some part of code from Tom Beauford, from AUGI
;;; ;http://forums.augi.com/showthread.php?t=77962
;;; ; Set 'Border Offset Factor' to 1.15
(vl-load-com)
(defun c:BA (/ *error* ttm2 ss elist sel1 sel3 dimt)
;;; error handler
(defun *error* (#Message)
(and dimt (setvar "dimtfill" dimt))
(and #Message
(not (wcmatch (strcase #Message) "*BREAK*,*CANCEL*,*QUIT*"))
(princ (strcat "\nError: " #Message))
) ;_ and
) ;_ defun
;;Using code from Roberto Gonzalez -robierzogg- from HISPACAD
;;http://www.hispacad.com/foro/viewtop...dfd60078f79c08
;;;This routine works only if Express tools are installed
;;; Convert selected text into Mtext
(command "undo" "begin") ;beginning of undo group
(defun ttm2 (name_n / collect n name_n insertpt name_n1 newlist)
(setq insertpt (assoc 10 (entget name_n)))
;Convert Text to Mtext, using the EXPRESS command
(command "txt2mtxt" name_n "")
;We set their original insertion point here
(setq name_n1 (entlast))
(SETQ newlist (SUBST insertpt (ASSOC 10 (ENTGET name_n1)) (ENTGET name_n1)))
(ENTMOD newlist)
(SETQ newlist (SUBST '(71 . 7) (ASSOC 71 (ENTGET name_n1)) (ENTGET name_n1)))
(ENTMOD newlist)
(SETQ newlist (SUBST '(46 . 0) (ASSOC 46 (ENTGET name_n1)) (ENTGET name_n1)))
(ENTMOD newlist)
(SETQ newlist (SUBST '(41 . 0) (ASSOC 41 (ENTGET name_n1)) (ENTGET name_n1)))
(ENTMOD newlist)
) ;_ defun
(setq dimt (getvar "dimtfill"))
(setvar "dimtfill" 1)
(princ "\nSelect Dimensions and text to apply the background fill and update...: ")
(and (setq ss (ssget "_:L" '((0 . "MTEXT,*DIMENSION*,TEXT"))))
(foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(cond
((eq "MTEXT" (cdr (assoc 0 (setq elist (entget x)))))
(vla-put-backgroundfill (vlax-ename->vla-object x) :vlax-true)
(setq elist (subst (cons 41 0.0) (assoc 41 elist) elist)
elist (subst (cons 46 0.0) (assoc 46 elist) elist)
elist (subst (cons 45 1.15) (assoc 45 elist) elist)
elist (subst (cons 421 256) (assoc 421 elist) elist)
) ;_ setq
(entmod elist)
)
((eq "TEXT" (cdr (assoc 0 (entget x))))
(ttm2 x)
(ssdel x ss)
(vla-put-backgroundfill (vlax-ename->vla-object (setq elist (entlast))) :vlax-true)
(ssadd elist ss)
(setq elist (entget elist))
(setq elist (subst (cons 45 1.15) (assoc 45 elist) elist)
elist (subst (cons 421 256) (assoc 421 elist) elist)
) ;_ setq
(entmod elist)
)
(T T)
) ;_ cond
) ;_ foreach
(vl-cmdf "_.-dimstyle" "_apply" ss "")
(vl-cmdf "_.draworder" ss "" "_f")
) ;_ and
(if (setq sel5 (ssget "_X" '((0 . "INSERT")(2 . "CENTER LINE2,COLUMN ROW BUBBLE2,DETAIL BUBBLE 12,DETAIL BUBBLE2,DUST PICK UP POINT2,EQUIPMENT TAG2,FULL SECTION LR2,FULL SECTION UD2,FULL SECTION2,MATCH LINE SP2,MATCH LINE2,NORTH ARROW2,NOTE BOX2,NOTE ENCL2,PARTIAL SECTION T2,PARTIAL SECTION2,PLATE2,REVISION2,SAMPLE NUMBER2,SECTION CUT UD2,SECTION CUT2,STAMP BIG2,STAMP SMALL2,STREAM NUMBER2,STREAM SEQUENCE2,TAG2,TITLE 12,TITLE BUBBLE 12,TITLE BUBBLE2,TITLE2,WORK POINT2,ROOMTAG,ROOMTAG2,DOORTAG,WALLTAG,WINDOWTAG,MULTIPLE DETAIL,IND WALL CEIL 1, IND WALL UP 1, IND WALL L 1, IND WALL R 1, IND WALL DN 1"))))
(vl-cmdf "_.draworder" sel5 "" "_f")
) ;_ if
(if (setq sel4 (ssget "_X" '((0 . "line,lwpolyline,insert,polyline,arc,circle,spline,hatch,region"))))
(vl-cmdf "_.draworder" sel4 "" "_b")
) ;_ if
(if (setq sel1 (ssget "_X" '((0 . "leader,*Dimension*"))))
(vl-cmdf "_.draworder" sel1 "" "_f")
) ;_ if
(if (setq sel3
(ssget "_X"
'((0 . "line,lwpolyline,polyline")
(8 . "Dims,Ar-Dims,G-Dims,M-Dims,E-Dims,S-Dims,P-Dims")
)
) ;_ ssget
) ;_ setq
(vl-cmdf "_.draworder" sel3 "" "_f")
) ;_ if
(setvar "dimtfill" dimt)
(princ)
(command "undo" "end") ;end of undo group
) ;_ defun
(princ
"\Type \"BA\" to mask all text, mtext and dimensions at once."
)
(princ
"\Remember to set dimscale according to selected dimensions before using it."
)
A guy in the autodesk forum asked for multileaders to be added to this lisp.... but Couldn´t even make it work for them.... anyway, it works perfect for us as it is.
Bookmarks