block byblock transparency

[jim78b]

(defun c:setbyblock ( / _byblock e n x a sel c)

    (defun _byblock ( n l / a e x )
        (if (and (setq e (tblobjname "BLOCK" n)) (not (member n l)))
            (while (setq e (entnext e))
                (setq x (entget e))
                (if (setq a (assoc 420 x))
                    (setq x (vl-remove (assoc 420 x) x))
                )
                (if (setq a (assoc 62 x))
                    (entmod (subst '(62 . 0) a x))
                    (entmod (append x '((62 . 0))))
                )
                (if (= "INSERT" (cdr (assoc 0 x)))
                    (_byblock (cdr (assoc 2 x)) (cons n l))
                )
            )
        )
        nil
    )

    (prompt "\nSelect Blocks: ")
    (setq sel (ssget (list (cons 0 "INSERT"))))
    (setq c 0)
    (repeat (sslength sel)
        (setq n (ssname sel c))       
        (_byblock (cdr (assoc 2 (entget n))) nil)
        (setq c (1+ c))
    )
    
    (command "_.regen")
    (princ)
    
)

Merry Christmas and best wishes to all, I would kindly need you to change this code so that it also makes the byblock transparency in addition to the color of the blocks

[Steven P]

Holidays... CAD is off, but if it is like layer transparency then you might need to look at extended entity definitions, I think Lee Mac had something somewhere for layers that might apply - check his website or search on this forum.

 

 

Could always double check, set a block to a transparency, I tend to use 12.3456 because that number is easy to spot, and do an (entget(car(entsel))) to the block and see if you can spot an part of the definition with 12.3456.. and that is what to change

[jim78b]

Can you modify the code please ? I am not familiar with lisp. Only want tò setbyblock block .color: setbyblock

Transparency: byblock

[BIGAL]

"Not familiar with lisp" but you have 662 posts time to start learning and experimenting.

[rlx]

I have to agree with Bigal about to (new)bee or not to (new)bee 

 

but to give you an idea

; (setq val (getentitytransparency (car (entsel))))
(defun getentitytransparency ( ent )
  (cond ((= 'vla-object (type ent))(vla-get-entitytransparency ent))
        ((= 'ename (type ent))(getentitytransparency (vlax-ename->vla-object ent)))))

; (< lower-limit test-number upper-limit)
; (putentitytransparency (car (entsel)) "ByBlock") (putentitytransparency (car (entsel)) 100)
(defun putentitytransparency (e v / i o)
  (cond ((null v)(setq v "ByLayer"))((and (numberp v)(< 0 v 90))(setq v (itoa (fix v))))
        ((and (= (type v) 'STR) (distof v) (>= 0 (setq i (fix (distof v))) 90))(setq v (itoa i)))
        ((and (= (type v) 'STR) (member (strcase v t)'("bylayer" "byblock"))) v)(t (setq v "0")))
  (if (setq o (e->o e))(vla-put-entitytransparency o v)))

 

[jim78b]

I'm working and I don't have time. Not everyone is as good at programming as you.

Why did you respond so rudely?

I think that without creating unnecessary controversy you could have not responded if the matter bothered you.

Did you have a bad Christmas?

However thanks

Edited 8 hours ago by jim78b

[jim78b]

so this makes the color byblock and the transparency byblock in the blocks?

[jim78b]

I would like to help someone who, like me, will need it and post the list.

 

(defun c:SetByBlockDeep (/ sel i ent obj name nameList)
  (vl-load-com)
  
  ;; --- Funzione Ricorsiva per processare le definizioni ---
  (defun process-block-def (blockName / bDef)
    (setq bDef (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blockName))
    
    (vlax-for subEnt bDef
      ;; 1. Cambia Colore e Trasparenza dell'entità corrente
      (vla-put-color subEnt 0) ; 0 = ByBlock
      (vla-put-entitytransparency subEnt "ByBlock")
      
      ;; 2. Se l'entità è a sua volta un blocco (nidificato), processa la sua definizione
      (if (= (vla-get-ObjectName subEnt) "AcDbBlockReference")
        (progn
          (if (vlax-property-available-p subEnt 'EffectiveName)
            (process-block-def (vla-get-EffectiveName subEnt))
            (process-block-def (vla-get-Name subEnt))
          )
        )
      )
    )
  )
  ;; -------------------------------------------------------

  (princ "\nSeleziona blocchi (verranno processati tutti i livelli nidificati)...")
  (if (setq sel (ssget '((0 . "INSERT"))))
    (progn
      (setq nameList '())
      (repeat (setq i (sslength sel))
        (setq ent (ssname sel (setq i (1- i))))
        (setq obj (vlax-ename->vla-object ent))
        
        ;; Ottieni il nome (gestendo i dinamici)
        (if (vlax-property-available-p obj 'EffectiveName)
          (setq name (vla-get-EffectiveName obj))
          (setq name (vla-get-Name obj))
        )
        
        ;; Se non abbiamo ancora processato questo blocco, avvia la ricorsione
        (if (not (member name nameList))
          (progn
            (process-block-def name)
            (setq nameList (cons name nameList))
          )
        )
      )
      
      (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports)
      (princ (strcat "\nCompletato. " (itoa (length nameList)) " definizioni di blocco e relativi sotto-blocchi aggiornati."))
    )
    (princ "\nNessun blocco selezionato.")
  )
  (princ)
)

 

[rlx]

I have done something like this a couple of years ago :

 

 

 

[SLW210]

Most of the members here have real jobs as well and provide help as their own busy schedules allow.

 

I do not believe anyone was being rude, just nudging you along to do a little work for yourself.