LISP pour redéfinir les blocs d\'un dessin

[LUDWIG]

Rebonjour,

 

Quelqu'un connaîtrait--il un lisp qui permettrait de redéfinir tous les blocs d'un dessin en "calque 0, couleur DuBloc, etc" ? :exclam:

[phco]

Ci-dessous un exemple de macro VBA qui pourrait peut-être t'inspirer.

Salutations PhCo

 

 

Private Sub CommandButton10_Click()

'Change la couleur des attributs du bloc PT_NIVEAU en BYLAYER

 

'Balayage des éléments du plan

For Each elem In ThisDrawing.ModelSpace

'Teste s'il s'agit d'un bloc

If StrComp(elem.EntityName, "AcDbBlockReference", 1) = 0 Then

'Il s'agit d'un bloc, teste s'il a des attributs:

If elem.Name = "PT_NIVEAU" Then

If elem.HasAttributes Then

'Ecriture des attributs du bloc dans array1:

array1 = elem.GetAttributes

'Balayage des attributs dans array1:

For I = LBound(array1) To UBound(array1)

'Couleur des attributs

array1(I).color = acByLayer

Next I

End If 'Fin du test s'il a des attributs

 

End If 'Fin du test s'il s'agit de PT_NIVEAU

 

elem.Update

End If 'Fin du test s'il s'agit d'un bloc

Next elem 'Fin du balayage des éléments du plan

End Sub

 

[LUDWIG]

Bon j'ai pas tout suivi car je ne suis pas trop VBiste, mais ton exemple parle d'Attribut. Or, je veux changer la couleur de chaque entité constituant le bloc (ligne, attribut, hachure, cercle, polyligne, etc).

 

En LISP, je ne sais pas comment sélectionner l'entité X qui appartient au bloc Z. Y-a-t'il un code de groupe particuler ?

 

[Edité le 7/12/2004 par LUDWIG]

[Patrick_35]

Salut,

Je viens de faire un lisp que devrai te convenir. Il ne met que les blocs qui sont défini dans la base sur la couche 0. Rien n’est changé en ce qui concerne les blocs qui sont déjà insérés (juste pour le calque d’insertion, les entités elles sont redéfinies) ainsi que les attributs qui en découlent, ce qui n’est pas le cas de ceux qui sont déjà défini dans la base.

 

Maintenant, si tu veux aussi changer les couleurs, les styles, etc.., c'est une base de départ

 

@+

 

(defun c:bl(/ i n tot)
 (setq i (tblnext "block" t) tot 1)
 (while i
   (setq n (cdr (assoc -2 i)))
   (while n
     (setq n (entget n))
     (if (/= (cdr (assoc 8 n)) "0")
       (progn
         (setq n (subst (cons 8 "0") (assoc 8 n) n))
         (entmod n)
       )
     )
     (setq n (entnext (cdr (assoc -1 n))))
   )
   (setq i (tblnext "block") tot (1+ tot))
 )
 (princ (strcat "\nTraitement de " (itoa tot) " bloc(s)"))
 (princ)
)

[Tramber]

Rebonjour,

 

Quelqu'un connaîtrait--il un lisp qui permettrait de redéfinir tous les blocs d'un dessin en "calque 0, couleur DuBloc, etc" ? :exclam:

 

Si je te prends aux mots, il suffit de filtrer tes blocs et de régler les paramètres d'un clic !

 

Tu veux sans doute intervenir sur les entités composant le bloc.

 

Il faut :

mettre une balise

faire un entget sur le bloc

exploser

traiter

redefinir le bloc avec entmake avec les objets depuis la balise

faire une insertion du bloc.

 

Tout ceci en traitement par lots,...y' a du job !

[Patrick_35]

Tramber, c'est ce que fait le lisp sans pour autant décomposer le bloc, changer de calque, puis refaire le bloc. Il intervient directement dans la base

 

@+

[LUDWIG]

Salut,

Je viens de faire un lisp que devrai te convenir. Il ne met que les blocs qui sont défini dans la base sur la couche 0. Rien n’est changé en ce qui concerne les blocs qui sont déjà insérés (juste pour le calque d’insertion, les entités elles sont redéfinies) ainsi que les attributs qui en découlent, ce qui n’est pas le cas de ceux qui sont déjà défini dans la base.

 

Maintenant, si tu veux aussi changer les couleurs, les styles, etc.., c'est une base de départ

 

 

Merci beaucoup. Je n'ai pas trop compris l'explication de ton message précédent ton lisp. Est-ce que tu veux dire que le lisp ne change pas le calque d'insertion du bloc mais seulement le calque des objets qui le composent ?

 

En tout cas, c'est exactement ce que je voulais. Ca marche à merveille. Il faut maintenant que je le modifie pour qu'il passe la couleur des entités dans les blocs en "DuBloc". Si je n'y arrive pas, je reposterai...

 

En tout cas, je pense que ton lisp en intéressera plus d'un, c'est toujours galère d'avoir des blocs mal définis dans un dessin.

 

Question : Est-ce que j'interprète bien

(defun c:bl(/ i n tot)

(setq i (tblnext "block" t) tot 1) RECHERCHE LES BLOCS DU DESSIN

(while i

(setq n (cdr (assoc -2 i))) POUR LE BLOC I, EXTRAIT LA REFERENCE DE CE BLOC

(while n

(setq n (entget n)) SELECTIONNE LA PREMIERE ENTITE N APPARTENANT AU BLOC I

(if (/= (cdr (assoc 8 n)) "0")

(progn

(setq n (subst (cons 8 "0") (assoc 8 n) n)) SI L'ENTITE N'EST PAS SUR 0, LA DEPLACE SUR 0

(entmod n)

)

)

(setq n (entnext (cdr (assoc -1 n)))) ENTITE SUIVANTE

)

(setq i (tblnext "block") tot (1+ tot)) BLOC SUIVANT

)

(princ (strcat "\nTraitement de " (itoa tot) " bloc(s)"))

(princ)

)

[Patrick_35]

pour l'explication, oui, c'est exactement cela

 

Et pour être un peu plus précis

 

(setq i (tblnext "block" t)) ; RECHERCHE LA PREMIERE ENTREE DANS LA TABLE DES BLOCS

(setq n (cdr (assoc -2 i))) ; SELECTIONNE LA PREMIERE ENTITE QUI COMPOSE LE BLOC

(setq n (entget n)) ; RECUPERE LES VALEURS DES ENTITES QUI COMPOSE LE BLOC

 

Autrement, pour le reste, c'est parfait

 

@+

[Tramber]

Encore une fois, je m'apercois que mes méthodes sont un peu tirées par les cheveux.

 

Je dispose un bloc dans le dessin, l'explose et le recompose tout fier avec entmake.

 

Plutôt que de traiter l'entité dans la table des blocs...

 

Bouh, ici, c'est pas débuter, c'est pour aller plus loin !

[LUDWIG]

Mais non Tramber, moi aussi je fais comme ça quand j'ai quelques blocs à redéfinir dans quelques dessins.

 

Mais là, je dois avoir 250 fichiers avec 20 blocs à redéfinir en moyenne... Tu vois le travail. D'ou l'utilité de générer un script (que tu aimes tant !) sur la liste des fichiers en appelant un script (celui de Patrick_35) qui redéfinit correctement les blocs...

 

Au fait, en parlant script, tu utilises quoi pour récupérer des listes de fichiers dans Excel ?

[Patrick_35]

Je compatis Tramber, et on est tous passé par là

 

Pour Ludwig

 

Un truc simple, sous dos, tu fais

 

dir *.dwg /on /s /b > fichier.txt

 

Et il ne te reste plus qu'à importer sous excel la liste de tes fichiers (perso, je passe plus par un éditeur de texte avec un rechercher/remplacer, mais les goûts et les couleurs...)

 

http://smileys.smileycentral.com/cat/36/36_1_37.gif

 

@+

[Tramber]

 

Au fait, en parlant script, tu utilises quoi pour récupérer des listes de fichiers dans Excel ?

 

J'utilises un listeur formidable même si il a le défaut d'obliger à avoir le titre de chaque dossier, sinon, il est complet ce logiciel :

 

http://gratuiciel.prv.pl/

 

 

;)

[LUDWIG]

Moi j'utilise pas dir *.dwg /on /s /b > fichier.txt car au niveau des accents (¨^çéà...) c'est galère...

 

J'utilises le logiciel PCATALOG en français et qui exporte direct sur Excel. Je vous le recommande...

 

http:// http://www.01net.com/telecharger/windows/Bureautique/gestion_k7_dvd_cd_vin/fiches/25719.html

[ici]

bonjour

en recherchant dans mes archives j'ai trouve ca

 

;;Power-CLic gratuiciel/partagiciel :

;;HTTP://WWW.POWER-CLIC.COM

;; BLOC_0 BLARG0

(if pw-foreign

(progn

(Prompt "\nAll drawing's block redefinition © G-EAUX 2001 ")

(prompt "\nBloc_o to put all entiies on 0 layer")

(prompt "\nblarg0 to make all entities with bylayer width")

(prompt "\nbcoul0 to make all entities with byblock color")

)

(progn

(Prompt "\nredéfinition automatique des blocs © G-EAUX 2001 ")

(prompt "\nBloc_o pour que les entités soit sur le calque 0")

(prompt "\nblarg0 pour largeur ducalque")

(prompt "\nbcoul0 pour couleur dubloc")

)

)

 

 

;;definit tous les bloc fait de calque 0

;;define all block made with layer zero entities

;

(defun c:bloc_0 ( / ent first to_0 )

 

(defun to_0 ( / tmp eg)

(while ent

(setq eg (entget ent))

(if (not (equal (setq tmp (assoc 8 eg)) '(8 . "0")))

(progn

(setq eg (subst '(8 . "0") tmp eg))

(entmod eg)

;(print eg)

(entupd ent)

)

)

 

(setq ent (entnext ent))

 

)

)

(setq first (tblnext "block" 't))

(setq ent (cdr ( assoc -2 first )))

(to_0)

(while (setq ent (tblnext "block" ))

(setq ent (cdr ( assoc -2 ent )))

(to_0)

)

(command "._regen")

)

 

;;definit tous les bloc fait de ligne de largeur ducalque

;;define all block made of byblock color entities

;

(defun c:blarg0 ( / ent first to_l0 )

 

(defun to_l0 ( / tmp eg )

(while ent

(setq eg (entget ent))

(if (print (setq tmp (assoc 370 eg)))

(progn

(print (setq eg (subst '(370 . -2) tmp eg)))

(entmod eg)

;(print eg)

(entupd ent)

)

)

 

(setq ent (entnext ent))

 

)

)

(setq first (tblnext "block" 't))

(setq ent (cdr ( assoc -2 first )))

(to_l0)

(while (setq ent (tblnext "block" ))

(setq ent (cdr ( assoc -2 ent )))

(to_l0)

)

(command "._regen")

)

 

;;definit tous les bloc fait de ligne de couleur dubloc

;;define all block made of byblock color entities

;

(defun c:bcoul0 ( / ent first to_c0 )

 

(defun to_c0 ( / tmp eg )

(while ent

(setq eg (entget ent))

(if (print (setq tmp (assoc 62 eg)))

(progn

(print (setq eg (subst '(62 . 0) tmp eg)))

(entmod eg)

;(print eg)

(entupd ent)

)

)

 

(setq ent (entnext ent))

 

)

)

(setq first (tblnext "block" 't))

(setq ent (cdr ( assoc -2 first )))

(to_c0)

(while (setq ent (tblnext "block" ))

(setq ent (cdr ( assoc -2 ent )))

(to_c0)

)

(command "._regen")

)

 

j'espere que ca va