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!
Solved! Go to Solution.
Solved by hmsilva. Go to Solution.
Solved by hmsilva. Go to Solution.
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)
)
)
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
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) )
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
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
I read recently an excellent explanation about it.
Thank you Lee
Henrique
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)
@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
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?
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
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!
@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
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!
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
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!
@ 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) )