;;; ;BA.lsp  -BACKGROUND FILL ALL-
;;; ;Made for M3 Mexicana. Coding Selected by Paulo Gil Soto. December 2009
;;; ;This routine will set a background color fill to all selected text, 
;;; ;mtext and dimensions, text objects will be converted to mtext with width=0
;;; ;and then will add their text box control points
;;; ;It will bring objects in layer 'Dims' to front at the end, as well as other
;;; ;Draworder operations according to M3 standards.
;;; ;Reviewed and modified by: Alan J. Thompson. 'alanjt@gmail.com'
;;; ;And Marco Antonio Jacinto Perez 'mcoan001@hotmail.com'
;;; ;December 2009
;;;

(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/viewtopic.php?p=142823&sid=b23c3147d2a06a29d1dfd60078f79c08
;; 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
;;;creo que esta parte mueve los nuevos mtextos de posicion hacia arriba
;;;no se por que lo pusieron?
    (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


;;; Aqui pongo la variable Mtexts como un parametro, el cual corresponde al ss
;;; que vas creando con los nuevos Mtextos
  (DEFUN mw5 (mtexts / mtexts idx ename EntData dxf42 dxf43 EntData1)
					;Reset Width - Mtext
    (IF	mtexts
;; Aqui se hace el cambio para que en lugar
;; de cambiar todos los mtextos, solo modifique los que recien creaste
;; (setq mtexts (ssget "_X" '((0 . "MTEXT"))))
;; Rogerio Brazil from an autodesk Discussion groups
;; http://discussion.autodesk.com/forums/thread.jspa?messageID=6339167&tstart=0
      (PROGN
	(SETQ idx 0)
	(REPEAT	(SSLENGTH mtexts)
	  (SETQ ename (SSNAME mtexts idx))
	  (SETQ EntData (ENTGET ename '("*")))
	  (SETQ dxf42 (* (CDR (ASSOC 42 EntData))1.07))
	  (SETQ dxf43 (CDR (ASSOC 43 EntData)))
	  (SETQ	EntData1
		 (ENTMOD (SUBST (CONS 41 dxf42) (ASSOC 41 EntData) EntData))
	  )
	  (ENTMOD (SUBST (CONS 46 dxf43) (ASSOC 46 EntData1) EntData1)
	  )
	  (SETQ idx (1+ idx))
	)				;progn
      )					;repeat
      (PRINC "\n Null Selection!")
    )					;if
    (PRINC)
  )


;;
;;
;;				; MAIN ROUTINE
;;
;;
;; Some part of code from Tom Beauford, from AUGI
;; http://forums.augi.com/showthread.php?t=77962
;; Set 'Border Offset Factor' to 1.15

  (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

(setq 
    BkLst 
           '("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"     "MULTIPLE DETAIL"
        ) 
    NomBloques (car BkLst) 
    BkName     (mapcar '(lambda    (x) 
              (setq NomBloques (strcat NomBloques "," x)) 
            ) 
               (cdr BkLst) 
           ) 
  ) 
  (if (setq sel5 (ssget "_X" (list '(-4 . "<OR") 
                    ; _Se seleccionan todos los bloques de 
                    ; usuario, despues se procesaran los 
                    ; nombres esto para poder procesar los 
                    ; bloques dinamicos 
                   '(-4 . "<AND") 
                   '(0 . "INSERT") 
                   (cons 2 (strcat NomBloques ",`*U*")) 
                   '(-4 . "AND>") 
                   '(-4 . "OR>") 
             ) 
          ) 
      ) 


    (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

  (mw5 ss)

) ;_ defun
(PRINC
  "\Type \"BA\" to mask all text, mtext and dimensions, adding mtext box"
)


;|«Visual LISP© Format Options»
(80 2 40 2 nil "end of " 60 9 2 0 0 T T T T)
;*** DO NOT add text below the comment! ***|;