set byblock con colori rgb problema

jim78b

Utente Standard
Professione: PROGETTISTA
Software: Solidworks 2016- autocad mech 2013-2017
Regione: lombardia
#1
Ciao, ho un lisp che mette tutti i colori su byblock anche nei blocchi nidificati ma mis on accorto oggi che con i colori rgb non li cambia proprio (intendo se in un blocco lo edito e metto le entità su un colore rgb es 245,0,0 e poi esco dal blocco e lancio il lisp non mi mette le entità su byblock....se riuscite a corregere la routine grazie

(defun c:setbyblock ( / _byblock e )

(defun _byblock ( n l / a e x )
(if (and
(setq e (tblobjname "BLOCK" n))
(not (member n l))
)
(while (setq e (entnext e))
(if (setq a (assoc 62 (setq x (entget e))))
(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
)

(while
(progn (setvar 'errno 0) (setq e (car (entsel "\nSelect Block: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'ename (type e))
(if (= "INSERT" (cdr (assoc 0 (entget e))))
(_byblock (cdr (assoc 2 (entget e))) nil)
(princ "\nObject is not a block.")
)
)
)
)
)
(command "_.regen")
(princ)
)
 

rpor66

Utente Standard
Professione: Programmatore
Software: AutoCad, GstarCAD, CadWorx, Excel, Lisp, VBA
Regione: Sicilia
#2
Codice:
(defun c:setbyblock ( / _byblock e )

    (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
    )

    (while
        (progn
            (setvar 'errno 0) (setq e (car (entsel "\nSelect Block: ")))
            (cond
                ( (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                ( (= 'ename (type e))
                    (if (= "INSERT" (cdr (assoc 0 (entget e))))
                        (_byblock (cdr (assoc 2 (entget e))) nil)
                        (princ "\nObject is not a block.")
                    )
                )
            )
        )
    )
    (command "_.regen")
    (princ)
)
Ok?
 

jim78b

Utente Standard
Professione: PROGETTISTA
Software: Solidworks 2016- autocad mech 2013-2017
Regione: lombardia
#3
ciao grazie x il tempo dedicato, funziona ma non permette di selezionare più elementi , la funzione vecchia era così infatti, si potrebbe fare che seleziona più elementi? ...
 

rpor66

Utente Standard
Professione: Programmatore
Software: AutoCad, GstarCAD, CadWorx, Excel, Lisp, VBA
Regione: Sicilia
#4
Codice:
(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)
    
)
Aggiornato, ora permette la selezione multipla.
 

jim78b

Utente Standard
Professione: PROGETTISTA
Software: Solidworks 2016- autocad mech 2013-2017
Regione: lombardia
#5
grazie!, è abbastanza ringraziarti?! .
 

jim78b

Utente Standard
Professione: PROGETTISTA
Software: Solidworks 2016- autocad mech 2013-2017
Regione: lombardia
#8
ciao ho provato ma non funziona con i blocchi anonimi potresti farlo anche per quelli ?grazie
 

jim78b

Utente Standard
Professione: PROGETTISTA
Software: Solidworks 2016- autocad mech 2013-2017
Regione: lombardia
#10
Intendo quelli col simbolo * davanti.mi son accorto che forse certi lisp tipo il cambio colore di blocchi nidificati non va ma forse non si può pretendere ...