Block hatch fill transparency

Hello,

I apologize if my terminology is off as I generally do not work in CAD/LISP.

I am working on a lisp routine that draws blocks and adds attributes to the blocks (labels). I set the blocks to be a solid hatch and set their colour with (setvar "cecolor" "255").

After I finished I realized it would be nice to add the ability to draw the blocks without fill if the user wishes. I thought their would be a system variable something like (setvar "transparency" "100") but I can't find anything.

Does anyone know how to set the transparency of block fill using LISP or how to set the colour to NULL?

Thanks

You can use the Visual LISP ActiveX entitytransparency property to set the transparency for an object, e.g.:

(defun c:t50 ( / obj )
   (if
       (and
           (setq obj (car (entsel)))
           (setq obj (vlax-ename->vla-object obj))
           (vlax-property-available-p obj 'entitytransparency t)
           (vlax-write-enabled-p obj)
       )
       (vla-put-entitytransparency obj 50)
   )
   (princ)
)
(vl-load-com) (princ)

Great,

Thank you very much.

You're very welcome David.

On 5/16/2013 at 1:00 AM, Lee Mac said:

You can use the Visual LISP ActiveX entitytransparency property to set the transparency for an object, e.g.:

 

 

(defun c:t50 ( / obj )
   (if
       (and
           (setq obj (car (entsel)))
           (setq obj (vlax-ename->vla-object obj))
           (vlax-property-available-p obj 'entitytransparency t)
           (vlax-write-enabled-p obj)
       )
       (vla-put-entitytransparency obj 50)
   )
   (princ)
)
(vl-load-com) (princ)

 

 

Hi Lee

I'm quite new at Lisp programming, so please bear with me.

Your code above is very close to something I am looking for. I need  a routine do do the following:

1. Cycle through all entities inside a block

2. Only ff the entity is a solid, set the transparency of the solid to 50%

3. Routine to include a function to reset the solid's transparency to "ByLayer" (effectively reversing the above)

I have managed to come up with the following code (editing an existing routine I found on one of the forums). This works, but I don't think it's the right way of doing it. Please show me the correct way of getting this done.

(defun c:TP1 ( / e i l n s x )
   (if (setq s (ssget '((0 . "INSERT"))))
       (repeat (setq i (sslength s))
           (if (not (member (setq n (cdr (assoc 2 (entget (ssname s (setq i (1- i))))))) l))
               (progn
                   (setq e (tblobjname "block" n)
                         l (cons n l)
                   )
                   (while (setq e (entnext e))
                       (setq x (entget e))
					   (if (equal "SOLID" (cdr (assoc 0 x)))
					   (entmod (subst '(440 . 33554559) (assoc 8 x) x))
					   )
                   )
               )
           )
       )
   )
   (command "_.regen")
   (princ)
)


(defun c:TP2 ( / e i l n s x )
   (if (setq s (ssget '((0 . "INSERT"))))
       (repeat (setq i (sslength s))
           (if (not (member (setq n (cdr (assoc 2 (entget (ssname s (setq i (1- i))))))) l))
               (progn
                   (setq e (tblobjname "block" n)
                         l (cons n l)
                   )
                   (while (setq e (entnext e))
                       (setq x (entget e))
					   (if (equal "SOLID" (cdr (assoc 0 x)))
                       (entmod (subst '(440 . 0) (assoc 440 x) x))
					   )
                   )
               )
           )
       )
   )
   (command "_.regen")
   (princ)
)

Your advice would be much appreciated!

Johan

Hi Johan,

This line immediately stands out:

(entmod (subst '(440 . 33554559) (assoc 8 x) x))

Here, you are substituting the transparency DXF group in place of the layer DXF group.

Instead, you should check for the presence of DXF 440, substitute if present, append if not:

(if (setq y (assoc 440 x))
    (entmod (subst '(440 . 33554559) y x))
    (entmod (append x '((440 . 33554559))))
)

8 hours ago, Lee Mac said:

Hi Johan,

 

This line immediately stands out:

(entmod (subst '(440 . 33554559) (assoc 8 x) x))

Here, you are substituting the transparency DXF group in place of the layer DXF group.

 

Instead, you should check for the presence of DXF 440, substitute if present, append if not:

(if (setq y (assoc 440 x))
    (entmod (subst '(440 . 33554559) y x))
    (entmod (append x '((440 . 33554559))))
)

 

 

Thanks so much Lee. I didn't know how to append

Really appreciate your help.