Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Mtext background toggle

18 REPLIES 18
SOLVED
Reply
Message 1 of 19
msarqui
1215 Views, 18 Replies

Mtext background toggle

Hi!

 

I am trying to merge two routines in one, but something is going wrong.

The routines I found here:

http://autocadtips.wordpress.com/2011/08/19/autolisp-background-text-mask-mtext-only/

 

And this is what I am trying to do:

 

(defun C:TMask (/ ss x ob1)
(vl-load-com)
(setq ss (ssget '((0 . "MTEXT"))))
(if ss
(mapcar '(lambda (x)
 (setq ob1 (vlax-ename->vla-object x))

 

(cond
 (if (= (vla-get-backgroundfill ob1) :vlax-false)
 (vla-put-backgroundfill ob1 :vlax-true)
 )

 (if (= (vla-get-backgroundfill ob1) :vlax-true)
  (vla-put-backgroundfill ob1 :vlax-false)
 )
)

 

)
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
)
)
(prin1)
)

 

What I am trying to achieve is:

         If the background mask is on, then turn it off but, If the background mask is off, then turn it on.

        

Any help?

Thanks!

18 REPLIES 18
Message 2 of 19
dbroad
in reply to: msarqui

Don't use if within cond as you did.  Cond takes lists.  The first element of the list is the conditional test.

 

(defun C:TMask (/ ss x ob1)
(vl-load-com)
(setq ss (ssget '((0 . "MTEXT"))))
(if ss
(mapcar '(lambda (x)
(setq ob1 (vlax-ename->vla-object x))
(princ)
(cond
((= (vla-get-backgroundfill ob1) :vlax-false)
(vla-put-backgroundfill ob1 :vlax-true)
)
((= (vla-get-backgroundfill ob1) :vlax-true)
(vla-put-backgroundfill ob1 :vlax-false)
)
)

Architect, Registered NC, VA, SC, & GA.
Message 3 of 19
msarqui
in reply to: dbroad

Sorry but it does not work. I think they're missing some parenthesis ...
Message 4 of 19
hmsilva
in reply to: msarqui

Your code, revised

 

(defun C:TMask (/ ss x ob1)
  (vl-load-com)
  (setq ss (ssget '((0 . "MTEXT"))))
  (if ss
    (mapcar
      '(lambda (x)
	 (setq ob1 (vlax-ename->vla-object x))
	 (vlax-put ob1 'backgroundfill (~ (vlax-get ob1 'backgroundfill)))
       )
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    )
  )
  (prin1)
)

HTH

Henrique

EESignature

Message 5 of 19
dbroad
in reply to: msarqui

Just take your code and delete the two IF words. Everything else is OK.  I would also change the (prin1) to (princ).

 

The following is your code without the ifs.

(defun C:TMask (/ ss x ob1)
(vl-load-com)
(setq ss (ssget '((0 . "MTEXT"))))
(if ss
(mapcar '(lambda (x)
 (setq ob1 (vlax-ename->vla-object x))
 
(cond
 ((= (vla-get-backgroundfill ob1) :vlax-false)
 (vla-put-backgroundfill ob1 :vlax-true)
 )
 ((= (vla-get-backgroundfill ob1) :vlax-true)
  (vla-put-backgroundfill ob1 :vlax-false)
 )
)
 
)
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
)
)
(princ)
)

 

Architect, Registered NC, VA, SC, & GA.
Message 6 of 19
Lee_Mac
in reply to: hmsilva

When using ssnamex allow iteration over objects in a selection, it should be more efficient to use a single loop, e.g.:

 

(defun c:tmask ( / o s )
    (if (setq s (ssget '((0 . "MTEXT"))))
        (foreach x (ssnamex s)
            (if (= 'ename (type (cadr x)))
                (progn
                    (setq o (vlax-ename->vla-object (cadr x)))
                    (vlax-put o 'backgroundfill (~ (vlax-get o 'backgroundfill)))
                )
            )
        )
    )
    (princ)
)
(vl-load-com) (princ)

 

Though, since ssnamex is quite slow to process, I would opt for the more common repeat:

 

(defun c:tmask ( / i o s )
    (if (setq s (ssget '((0 . "MTEXT"))))
        (repeat (setq i (sslength s))
            (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
            (vlax-put o 'backgroundfill (~ (vlax-get o 'backgroundfill)))
        )
    )
    (princ)
)
(vl-load-com) (princ)

 

Good use of the bitwise NOT toggle Henrique Smiley Wink

Message 7 of 19
hmsilva
in reply to: Lee_Mac


Lee_Mac wrote:

... 

Though, since ssnamex is quite slow to process, I would opt for the more common repeat:

 ...


Lee, I also would opt for the repeat...


@Lee_Mac wrote:

... 

Good use of the bitwise NOT toggle Henrique Smiley Wink


I read recently an excellent explanation about it. Smiley Wink

Thank you Lee

 

Henrique

EESignature

Message 8 of 19
Lee_Mac
in reply to: hmsilva


@hmsilva wrote:
I read recently an excellent explanation about it. Smiley Wink

Thank you Lee


Smiley Very Happy

Message 9 of 19
msarqui
in reply to: hmsilva

Thank you all for your time. All solutions are very good and they work the way I wanted.
question:
Why when I change (0. "MTEXT") for (0. "DIMENSION") does not work? (I'm trying something similar also for dimensions)

Message 10 of 19
hmsilva
in reply to: msarqui


@msarqui wrote:

Thank you all for your time. All solutions are very good and they work the way I wanted.
question:
Why when I change (0. "MTEXT") for (0. "DIMENSION") does not work? (I'm trying something similar also for dimensions)


You're welcome, msarqui

 

for dimensions, try

 

(vlax-put VlaObject 'textfill (~ (vlax-get VlaObject 'textfill)))

 

HTH

Henrique

 

EESignature

Message 11 of 19
msarqui
in reply to: hmsilva

Well, I tried this two routines for the dimension request and I have this error : bad argument type: VLA-OBJECT nil


(defun C:MDT1 (/ ss x ob1)
  (vl-load-com)
  (setq ss (ssget '((0 . "DIMENSION"))))
  (if ss
    (mapcar
      '(lambda (x)
  (setq ob1 (vlax-ename->vla-object x))
  (vlax-put VlaObject 'textfill (~ (vlax-get VlaObject 'textfill)))
       )
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    )
  )
  (prin1)
)

 

 

(defun c:MDT2 ( / i o s )
    (if (setq s (ssget '((0 . "DIMENSION"))))
        (repeat (setq i (sslength s))
            (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
            (vlax-put VlaObject 'textfill (~ (vlax-get VlaObject 'textfill)))
        )
    )
    (princ)
)
(vl-load-com) (princ)

 

Any help?

Message 12 of 19
hmsilva
in reply to: msarqui

msarqui,

 

the 'VlaObject' was just an example, you'll have to change it to the correct variable...

 

Try

 

(defun C:MDT1 (/ ss x ob1)
  (vl-load-com)
  (setq ss (ssget '((0 . "DIMENSION"))))
  (if ss
    (mapcar
      '(lambda (x)
  (setq ob1 (vlax-ename->vla-object x))
  (vlax-put ob1 'textfill (~ (vlax-get ob1 'textfill)))
       )
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    )
  )
  (prin1)
)

(defun c:MDT2 ( / i o s )
    (if (setq s (ssget '((0 . "DIMENSION"))))
        (repeat (setq i (sslength s))
            (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
            (vlax-put o 'textfill (~ (vlax-get o 'textfill)))
        )
    )
    (princ)
)
(vl-load-com) (princ)

 

HTH

Henrique

EESignature

Message 13 of 19
msarqui
in reply to: hmsilva

Oi Henrique,

 

It is almost perfect.

One last thing : the "fill color" I am having with the routine is "Byblock". Is that possible to have this to "Background"?

 

Thanks!  

Message 14 of 19
hmsilva
in reply to: msarqui


@msarqui wrote:

...

One last thing : the "fill color" I am having with the routine is "Byblock". Is that possible to have this to "Background"?

...


Quick and dirty:

 

(defun c:demo (/ ent entdata hnd i newentdata ss xdata)
  (if (setq ss (ssget '((0 . "Dimension"))))
    (repeat (setq i (sslength ss))
      (setq hnd	(ssname ss (setq i (1- i)))
	    ent	(entget hnd '("ACAD"))
      )
      (if (or (not (setq xdata (assoc -3 ent)))
	      (and (setq xdata (assoc -3 ent))
		   (member '(1000 . "DSTYLE") (last xdata))
		   (/= (cdr (assoc 1070 (reverse (last xdata)))) 1)
		   (setq ent (vl-remove-if '(lambda (x) (= -3 (car x))) ent))
	      );; and
	  );; or
	(setq entdata '((-3 ("ACAD" (1000 . "DSTYLE")(1002 . "{")(1070 . 69)(1070 . 1)(1002 . "}"))))
	      newentdata (append ent entdata))
	(setq ent (vl-remove-if '(lambda (x) (= -3 (car x))) ent)
	      entdata '((-3 ("ACAD"(1000 . "DSTYLE")(1002 . "{")(1070 . 69)(1070 . 0)(1002 . "}"))))
	      newentdata (append ent entdata))
	);; if
      (entmod newentdata)
    );; repeat
  );; if
  (princ)
);; demo

 

HTH

Henrique

EESignature

Message 15 of 19
msarqui
in reply to: hmsilva

Amazing work!


I used the routine and it does the job very well.

It has only one weird thing, but I think this is one those AutoCAD mysteries...

Look the attached file. Both dimensions are "fill color" "none" but, the left one does not change to "background" in the first time. I need to apply the routine two times in it. The right dimension is OK.

I checked the properties of the two dimensions and did not find anything different to justify the problem.

But, when I use the command MATCHPROP first, by applying the properties of the right dimension on the left dimension, then the routine works well.

It's not a big deal, because I can leave with this. I am telling you this just for a feedback. Perhaps it is something obvious ...


Thanks again!

Message 16 of 19
hmsilva
in reply to: msarqui

Hi msarqui,

 

again a quick and dirty one, and not really tested, but I think that will do the trick...

 

(defun c:demo (/ data ent hnd i newentdata pos ss xdata)
  (if (setq ss (ssget '((0 . "Dimension"))))
    (repeat (setq i (sslength ss))
      (setq hnd	(ssname ss (setq i (1- i)))
	    ent	(entget hnd '("ACAD"))
      )
      (cond ((not (setq xdata (assoc -3 ent)))
	     (setq data	      '((-3("ACAD"(1000 . "DSTYLE")(1002 . "{")(1070 . 69)(1070 . 1)(1002 . "}"))))
		   newentdata (append ent data)
	     )
	    )
	    ((and (setq xdata (assoc -3 ent))
		  (setq data (member '(1000 . "DSTYLE") (last xdata)))
		  (not (member '(1070 . 69) data))
	     )
	     (setq data	      (vl-remove (last data) data)
		   data	      (append data '((1070 . 69) (1070 . 1) (1002 . "}")))
		   data	      (list -3 (cons "ACAD" data))
		   ent	      (vl-remove-if '(lambda (x) (= -3 (car x))) ent)
		   newentdata (append ent (list data))
	     )
	    )
	    ((and (setq xdata (assoc -3 ent))
		  (setq data (member '(1000 . "DSTYLE") (last xdata)))
		  (setq pos (vl-position '(1070 . 69) data))
		  (= (cdr (nth (1+ pos) data)) 1)
	     )
	     (setq data	      (subst '(1070 . 0) (nth (1+ pos) data) data)
		   data	      (list -3 (cons "ACAD" data))
		   ent	      (vl-remove-if '(lambda (x) (= -3 (car x))) ent)
		   newentdata (append ent (list data))
	     )
	    )
	    (T
	     (setq xdata      (assoc -3 ent)
		   data	      (member '(1000 . "DSTYLE") (last xdata))
		   pos	      (vl-position '(1070 . 69) data)
		   data	      (subst '(1070 . 1) (nth (1+ pos) data) data)
		   data	      (list -3 (cons "ACAD" data))
		   ent	      (vl-remove-if '(lambda (x) (= -3 (car x))) ent)
		   newentdata (append ent (list data))
	     )
	    )
      );; cond
      (entmod newentdata)
    );; repeat
  );; if
  (princ)
);; demo

 

HTH

Henrique

EESignature

Message 17 of 19
msarqui
in reply to: hmsilva

So far it is perfect.

I will do more tests and I will let you know if I have future issues.

Thanks for this great job!

Message 18 of 19
hmsilva
in reply to: msarqui

You're welcome, msarqui
Glad I could help

 

Henrique

EESignature

Message 19 of 19
zimmerroo
in reply to: dbroad

@ Dbroad:  Just wanted to thank you for this LISP routine.  It's perfect.  I miss the old ability to turn background mask on/off in a very simple click. This lisp routine is exactly what I need to accomplish this.

 

For anyone else searching for this function, this routine is perfect.  I modified the double-click function (in my CUI) for the MText command to access this lisp routine instead of the MText editor.  Now when I double-click my Mtext, it will toggle the background on/off.  I use "ET" to access my text editor, so I can bypass the default double-click option for Mtext without concern.

 

Thanks again!

 

P.S. To make it easy for anyone, here is the functioning LISP routine:

 

(defun C:TMask (/ ss x ob1)
(vl-load-com)
(setq ss (ssget '((0 . "MTEXT"))))
(if ss
(mapcar '(lambda (x)
 (setq ob1 (vlax-ename->vla-object x))
 
(cond
 ((= (vla-get-backgroundfill ob1) :vlax-false)
 (vla-put-backgroundfill ob1 :vlax-true)
 )
 ((= (vla-get-backgroundfill ob1) :vlax-true)
  (vla-put-backgroundfill ob1 :vlax-false)
 )
)
 
)
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
)
)
(princ)
)

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost