Remplacement de bloc par un autre

[Fundream]

Voici ma problématique :

 

J'ai tout un tas de bloc contenant l'étiquette REF dans laquelle la valeur est la référence de l'élément.

Quand j’insère mes éléments, les étiquettes sont déjà remplis, inutiles d'y toucher elles ne servent qu'à l'extraction d'attribut pour la nomenclature.

La je dois remplacer plusieurs milliers d'élément par d'autres, pas de probleme avec les express tools les bloc sont remplacés en trois secondes. Le problème c'est que la valeur de l'étiquette REF n'est pas modifiée elle, et je me retrouve avec des éléments comportant des références qui ne sont pas les leur.

 

Donc quelqu'un aurait il une solution pour que la valeur de l'étiquette soit mise à jour également?

 

Merci

[Steven]

Salut.

 

Il y a le lisp RBLOC de Patrick_35 ;)

[Fundream]

Je voudrais bien mais le fichier est corrompu a priori...

[Patrick_35]

Je voudrais bien mais le fichier est corrompu a priori...

Salut

 

Le lien vient d'être réparé.

 

@+

[Fundream]

Merci. Qu'est ce que le .dcl?

[Steven]

Merci. Qu'est ce que le .dcl?

 

Le fichier dcl est le fichier qui te permet d'avoir une fenêtre de dialogue lors de tes remplacements de blocs avec différentes options.

Il fauut que le fichier .dcl et le fichier.lsp soit au même endroit pour que celà fonctionne.

 

http://pix.toile-libre.org/upload/img/1335445039.png

 

[Fundream]

Merci c'est bien ce que je pensais et Patrick me la confirmé en MP.

Super lisp en tout cas, les express tools peuvent aller se rhabiller.

[Fundream]

Bon allé on va dire que je suis gourmand mais bon...

Le lisp marche super bien mais dans mon cas il est un peu long a utiliser.

 

En fait j'ai énormément de bloc différents à remplacer par d'autres, c'est dans le cadre d'un changement de fournisseur et donc tout le matériel est remplacé par du matériel équivalent.

 

Ce qui serait vraiment génial c'est de pouvoir établir une liste de correspondance, et que le lisp se charge de tout changer en une seule fois, est-ce possible?

 

Merci

[Steven]

Pourrais-tu envoyer un de tes fichiers pour voir comment il est fait au niveau de tes blocs stp?

[Fundream]

Je te l'envoi en MP

[Steven]

Salut Fundream.

 

D'après ce que j'ai pu comprendre, tu un des blocs A que tu remplaces par des blocs B; Puis des blocs C que tu remplace par des blocs D; C'est bien ça? Le souci est que tes blocs B conservent les reférences d'attributs des blocs A et pareils avec les blocs C qui conservent les références d'attributs des blocs C. C'est bien ça? Pourquoi ne fais tu pas un Séléctionner similaire en sélectionnant un bloc B puis tu changes la référence d'attribut par la fenêtre de propriété?

[Fundream]

C'est tout a fait ça. je pourrais effectivement faire une sélection similaire mais ça va prendre pas mal de temps de retrouver toutes les bonnes référence des éléments et j'ai pas intérêt d'en oublier une seule sinon la nomenclature ne correspondra pas. D'ou mon interet pour le tout automatisé.

 

Merci de te pencher sur la question.

[bryce]

Bonjour,

 

Voici un Lisp qui pourra peut-être faire l'affaire.

Les "couples" de blocs sont cherchés dans un fichier texte:

- un couple par ligne

- sur chaque ligne, le nom du bloc à remplacer et le nom du nouveau bloc, séparés par un point-virgule.

Par exemple :

ancienbloc;nouveaubloc
bloca;blocb

 

Les blocs de remplacement doivent exister dans le dessin, ou sous forme de fichiers dwg dans un chemin de recherche d'AutoCAD.

 

(defun c:SWAPBLOCKS ( / acdoc ms *error* plist sep f l flst i ob nb ss vlnb )

 ; Caractère de séparation entre l'ancien bloc et le nouveau dans le fichier texte:
 (setq sep ";")

 ; Liste des propriétés de l'ancien bloc à appliquer au bloc de remplacement
 ; (l'échelle en X, Y et Z et l'angle de rotation sont récupérés d'office):
 (setq plist '("Layer" "TrueColor" "Linetype" "LinetypeScale" "LineWeight"))

 (vl-load-com)
 (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
       ms (vla-get-modelspace acdoc))

 (defun *error* (msg)
   (and msg
     (or
       (member (strcase msg) '("FUNCTION CANCELLED" "QUIT / EXIT ABORT" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON"))
       (princ (strcat "\nErreur : " msg))
     )
   )
   (if ss (setq ss nil))
   (vla-endundomark acdoc)
   (princ)
 )

 (vla-startundomark acdoc)
 
 (setq flst '()
       f (getfiled "" "" "txt" 4))
 (if (and f (setq f (open f "r")))
   (progn
     (while (setq l (read-line f))
       (setq flst (cons l flst))
     )
     (close f)
     (setq flst (reverse flst))
   )
 )
 
 (foreach l flst
   (setq i (vl-string-search sep l)
         ob (substr l 1 i)
         nb (substr l (+ i 2)))
   (princ (strcat "\n\nRemplacement de " ob " par " nb ":"))
   (setq ss (ssget "_X" (list (cons 0 "INSERT")(cons 2 ob)(cons 410 "Model") )))
   (if ss
     (if (or (tblsearch "BLOCK" nb) (setq nb (findfile (strcat nb ".dwg"))))
       (progn
         (setq i 0)
         (repeat (sslength ss)
           (setq ob (vlax-ename->vla-object (ssname ss i)))
           (setq vlnb (vla-insertblock ms
               (vla-get-InsertionPoint ob)
               nb
               (vla-get-XScaleFactor ob)
               (vla-get-YScaleFactor ob)
               (vla-get-ZScaleFactor ob)
               (vla-get-Rotation ob)))
           (foreach p plist
             (eval (read (strcat "(vla-put-" p " vlnb (vla-get-" p " ob))")))
           )
           (vla-delete ob)
           (setq i (+ 1 i))
         );repeat
         (setq ss nil)
         (princ (strcat "\n" (itoa i) " blocs remplacés."))
       );progn
       (princ (strcat "\nBloc " nb " non trouvé, remplacement non effectué."))
     );if
     (princ (strcat "\nAucun bloc " ob " à remplacer."))
   );if ss
 );foreach
 (*error* nil)
)

[Steven]

Je ne l'ai pas encore essayé, mais j'ai l'impression que Bryce nous a encore créer un lisp de ouf malade http://smileys.sur-la-toile.com/repository/Content/0057.gif

 

Sinon, as-tu essayé de d'exporter avec un ATTOUT tes attributs de blocs, remplacer toutes tes référence d'attributs dans le fichier texte via Excel puis faire un ATTIN pour les réimporter dans ton dessin?

[Fundream]

Que dire si ce n'est MERCI!!! Vraiment c'est impeccable là!

[Steven]

Que dire si ce n'est MERCI!!! Vraiment c'est impeccable là!

 

 

Cool :) Mais qu'elle méthode as-tu appliqué?

[Fundream]

Le lisp avec le txt par soucis d'automatisme. Merci encore.

[francinez]

Bonjour Bryce,

 

J'ai utilisé votre Lisp et cela fonctionne impeccablement.

J'aurais juste 2 questions:

-Est-il possible que l'on donne le nom du fichier txt directement dans le lisp?

-Les blocs que je veux renommer se trouve dans différents chemins, peux t-on les rajouter dans ce lisp?

Avec ces 2 changements je pourrais utiliser ce lisp sans avoir à ouvrir tous les plans.

 

Encore merci

Francine

[bryce]

Bonjour,

 

Pour la question 1, il faut remplacer cette partie

(setq flst '()
       f (getfiled "" "" "txt" 4))

par

(setq flst '()
       f "C:\\chemin vers le fichier texte\\fichier.txt")

Attention à bien doubler les \ dans le chemin.

 

Pour la question 2, je pense que le plus simple est d'ajouter les chemins en tant que chemins de supports dans les options d'AutoCAD (onglet Fichiers).

[FormaBois]

Bonjour,

est-il possible de faire quelque chose de similaire, sans être aussi sophistiqué, pour une version LT ?

[francinez]

Bonjour,

 

J'ai modifié le lisp selon vos indications et cela fonctionne parfaitement.

Concernant le point 2: mon soucis est que j'ai beaucoup trop de chemin. Je pensais pouvoir intégrer un lisp que j'utilise pour insérer un bloc de n'importe ou. Je vous le met en pièce jointe.

Pouvez vous m'aider svp car je n'ai aucune notion de programmation.

 

Encore merci

insrt.LSP

insrt.txt

[bryce]

Bonsoir,

 

Tu peux essayer le lisp ci-dessous (non testé).

Il faut modifier les chemins au début du code dans (setq f "...") et (setq d "...") pour pointer vers les bons fichiers.

Attention, le fichier listant les chemins de recherche doit être modifié pour remplacer tous les \ par des \\

 

(defun c:SWAPBLOCKS ( / acdoc ms *error* plist sep f d l flst dlst i ob nb ss vlnb )

 ; Chemin du fichier texte contenant les noms des blocs à remplacer et le nom des blocs
 ; de remplacement (chaque couple sur une ligne, avec un ; entre les 2 noms).
 (setq f "C:\\chemin vers le fichier texte\\remplacements.txt")
 
 ; Chemin du fichier texte contenant les chemins dans lesquels rechercher les blocs
 ; Les chemins doivent utiliser \\ !
 (setq d "C:\\chemin vers le fichier texte\\dossiers de recherche.txt")
 
 ; Caractère de séparation entre l'ancien bloc et le nouveau dans le fichier texte:
 (setq sep ";")

 ; Liste des propriétés de l'ancien bloc à appliquer au bloc de remplacement
 ; (l'échelle en X, Y et Z et l'angle de rotation sont récupérés d'office):
 (setq plist '("Layer" "TrueColor" "Linetype" "LinetypeScale" "LineWeight"))

;---------------------------------------------------------------------------------------------------------------------
 
;; Add Support File Search Paths  -  Lee Mac
;; Adds a list of Support File Search Paths, excluding duplicates and invalid paths.
;; lst - [lst] list of paths to add, e.g. '("C:\\Folder1" "C:\\Folder2" ... )
;; Returns: [str] "ACAD" Environment String following modification

(defun LM:sfsp+ ( lst )
   (   (lambda ( str lst )
           (if (setq lst
                   (vl-remove-if
                      '(lambda ( x )
                           (or (vl-string-search (strcase x) (strcase str))
                               (not (findfile x))
                           )
                       )
                       lst
                   )
               )
               (setenv "ACAD" (strcat str ";" (apply 'strcat (mapcar '(lambda ( x ) (strcat x ";")) lst))))
           )
       )
       (vl-string-right-trim ";" (getenv "ACAD"))
       (mapcar '(lambda ( x ) (vl-string-right-trim "\\" (vl-string-translate "/" "\\" x))) lst)
   )
)

;; Remove Support File Search Paths  -  Lee Mac
;; Removes a list of Support File Search Paths if present.
;; lst - [lst] list of paths to remove (case-insensitive), e.g. '("C:\\Folder1" "C:\\Folder2" ... )
;; Returns: [str] "ACAD" Environment String following modification

(defun LM:sfsp- ( lst / del str tmp )

   (defun del ( old str / pos )
       (if (setq pos (vl-string-search (strcase old) (strcase str)))
           (strcat (substr str 1 pos) (del old (substr str (+ 1 pos (strlen old)))))
           str
       )
   )   
   (setq str (strcat (vl-string-right-trim ";" (getenv "ACAD")) ";")
         tmp str
   )
   (foreach pth lst
       (setq str (del (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" pth)) ";") str))
   )
   (if (/= tmp str) (setenv "ACAD" str))
)

 (vl-load-com)
 (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
       ms (vla-get-modelspace acdoc))

 (defun *error* (msg)
   (and msg
     (or
       (member (strcase msg) '("FUNCTION CANCELLED" "QUIT / EXIT ABORT" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON"))
       (princ (strcat "\nErreur : " msg))
     )
   )
   (if ss (setq ss nil))
   (if dlst (LM:sfsp- dlst))
   (vla-endundomark acdoc)
   (princ)
 )

 (vla-startundomark acdoc)
 
 (setq flst '()
       dlst '() )
 (if (and f (setq f (open f "r")))
   (progn
     (while (setq l (read-line f))
       (setq flst (cons l flst))
     )
     (close f)
     (setq flst (reverse flst))
   )
   (*error* "Fichier de remplacement non trouvé !")
 )
 (if (and d (setq d (open d "r")))
   (progn
     (while (setq l (read-line d))
       (setq dlst (cons l dlst))
     )
     (close d)
     (LM:sfsp+ (setq dlst (reverse dlst)))
   )
 )
 
 (foreach l flst
   (setq i (vl-string-search sep l)
         ob (substr l 1 i)
         nb (substr l (+ i 2)))
   (princ (strcat "\n\nRemplacement de " ob " par " nb ":"))
   (setq ss (ssget "_X" (list (cons 0 "INSERT")(cons 2 ob)(cons 410 "Model") )))
   (if ss
     (if (or (tblsearch "BLOCK" nb) (setq nb (findfile (strcat nb ".dwg"))))
       (progn
         (setq i 0)
         (repeat (sslength ss)
           (setq ob (vlax-ename->vla-object (ssname ss i)))
           (setq vlnb (vla-insertblock ms
               (vla-get-InsertionPoint ob)
               nb
               (vla-get-XScaleFactor ob)
               (vla-get-YScaleFactor ob)
               (vla-get-ZScaleFactor ob)
               (vla-get-Rotation ob)))
           (foreach p plist
             (eval (read (strcat "(vla-put-" p " vlnb (vla-get-" p " ob))")))
           )
           (vla-delete ob)
           (setq i (+ 1 i))
         );repeat
         (setq ss nil)
         (princ (strcat "\n" (itoa i) " blocs remplacés."))
       );progn
       (princ (strcat "\nBloc " nb " non trouvé, remplacement non effectué."))
     );if
     (princ (strcat "\nAucun bloc " ob " à remplacer."))
   );if ss
 );foreach
 (*error* nil)
)

Modifié le 9 juillet 2016 par bryce

[francinez]

Bonjour,

J'ai essayé votre lisp mais je recois le message d'erreur:

Erreur : bad argument type: stringp nil

 

Dans le fichier txt pour les chemins j'ai bien mis \\

ex: G:\\TE-Templates\\01-AutoCADTemplates\\CAD\\ArticleLibrary\\03-ScrewNailRivet\\BN5951

G:\\TE-Templates\\01-AutoCADTemplates\\CAD\\ArticleLibrary\\03-ScrewNailRivet\\BN6029

 

Je viens de m'apercevoir que j'ai perdu certains chemins dans option.

Est-il possible d'intégrer ceci dans votre lisp:

(defun findblock ( dwg )

(vl-some '(lambda ( nb ) (findfile (strcat nb dwg)))

'( ""

"G:\\TE-Templates\\01-AutoCADTemplates\\CAD\\ArticleLibrary\\03-ScrewNailRivet\\BN5951\\

"G:\\TE-Templates\\01-AutoCADTemplates\\CAD\\ArticleLibrary\\03-ScrewNailRivet\\BN6029\\

"G:\\TE-Templates\\01-AutoCADTemplates\\CAD\\ArticleLibrary\\03-ScrewNailRivet\\DIN95\\

)

)

)

[bryce]

Bonjour,

 

En fait il ne faut PAS mettre des \\ dans le fichier qui contient les chemins !

J'ai été trop vite, et je me suis trompé ;)

 

Je viens de prendre le temps de faire un test, ça fonctionne

[francinez]

Bonjour,

 

J'ai remis un seul \ mais je recois encore le message: erreur: bad argument type: numberp: nil. Certains blocs sont modifés mais suite à cette erreur le lisp s'arrête. Je dois modifier mes fixations de A2 en A4.

 

Je vous renvoie le fichier lisp avec les TXT mais je n'arrive pas à vous envoyer le dwg correspondant!

 

Encore merci de votre aide.

ScrewNailRivet.txt

A2-A4.txt

SWAPBLOCKS.lsp