Cambiar la transparencia del sombreado en algunos bloques

Hola colegas.
Uso varios bloques (árboles) que tienen un sombreado transparente, unos del 30% otros del 50%, etc.
Necesito una rutina lisp que pueda modificar esa transparencia una vez insertado el bloque pues, dependiendo del dibujo, a veces las voy modificando.
Buscando en el foro de Autocad, encontré esta orden que publico al final
https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/change-hatch-transparency-in-nested-blocks/td-p/7375176
El problema es que modifica la transparencia del sombreado de todos los bloques del dibujo y lo que necesito es que pueda escoger, un bloque o varios a la vez, da igual, ¿algún maestro de este foro la puede modificar?
Nota: no me atrevo a preguntarlo en el foro citado porque mi nivel de inglés es peor que el de Tarzán.
Saludos y gracias

Código:


(defun c:HT ( / aDoc tr)
     (vl-load-com)
     (setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
     (if
       (progn
         (initget 132)
         (setq tr (getint "\nSpecify transparency (0-90): "))
         (cond
           ((eq (type tr) 'int)
            (if (<= 0 tr 90) (setq tr (itoa tr)))
           )
           ((eq (type tr) 'str)
            (or
              (wcmatch (strcase tr) "BYLAYER,BYBLOCK")
              (not (princ "\nInvalid value."))
            )
           )
         )
       )
       (vlax-for blk (vla-get-blocks aDoc)
         (if
           (and
             (eq :vlax-false (vla-get-islayout blk))
             (eq :vlax-false (vla-get-isxref blk))
           )
           (vlax-for itm blk
             (if
               (eq (vla-get-ObjectName itm) "AcDbHatch")
               (vla-put-entitytransparency itm tr)
             )
           )
         )
       )  
     )
     (vla-regen adoc acActiveViewport)
     (princ)
)

Hola

Quizás algo así

Código:

(defun c:HT ( / aDoc tr ins lnt blk itm)
   (vl-load-com)
   (setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
   (if
      (progn
         (initget 132)
         (setq tr (getint "\nSpecify transparency (0-90): "))
         (cond
            (   (eq (type tr) 'int)
               (if (<= 0 tr 90) (setq tr (itoa tr)))
            )
            (   (eq (type tr) 'str)
               (or
                  (wcmatch (strcase tr) "BYLAYER,BYBLOCK")
                  (not (princ "\nInvalid value."))
               )
            )
         )
      )
      ;Añaddo - seleccionar bloques en pantalla
      (while (setq ins (car (entsel)))
         (setq lnt (entget ins))
         (if (= (cdr (assoc 0 lnt)) "INSERT")
            (progn
               (setq blk (vla-item (vla-get-blocks aDoc) (cdr (assoc 2 lnt))))

            ;(vlax-for blk (vla-get-blocks aDoc)
               (if
                  (and
                     (eq :vlax-false (vla-get-islayout blk))
                     (eq :vlax-false (vla-get-isxref blk))
                  )
                  (vlax-for itm blk
                     (if
                        (eq (vla-get-ObjectName itm) "AcDbHatch")
                        (vla-put-entitytransparency itm tr)
                     )
                  )
               )
            )
         )
      )
   )
   (vla-regen adoc acActiveViewport)
   (princ)
)

Muchísimas gracias maestro Gerardo
Increíble la rapidez con la que has contestado y solucionado.
de nuevo gracias por tu interés y dedicación
Saludos
Miguel

a la orden
Saludos