[Résolu] Recréer les liens des XREFS

[stugeol]

Bonjour,

Voici le contexte, on viens de nous changer le serveur sur notre agence. Tous les liens concernant : les images, les xref (dwg, pdf, dgn, images...) ne sont plus valide.

Avec AdRefMan.exe, je dois sélectionner tous les dessin, puis changer la lettre du lecteur, ce qui permet un gain de temps mais est fastidieux pour des dossiers comportant plusieurs centaines de dessins.

Sous Excel ou sous Acces je peux répertorier la liste des fichiers .dwg et leur chemin, à l'aide d'une routine VBA.

Sous Autocad la routine suivante permet de faire ce changement de chemin dans le dessin courant :

<BR>Sub XREF3_Path()<BR>    Dim tempBlock As AcadEntity<BR>    Dim tempBlock2 As AcadBlock<BR>    Dim TempBlockImbr As AcadDatabase<BR>    Dim ob As AcadEntity<BR>    Dim chemin, chemin1, racine, msg As String<BR>    Dim result As Variant<BR>    On Error Resume Next<BR>    chemin = ""<BR>    chemin1 = ""<BR>    racine = "D:\"<BR>    'On scan l'espace objet<BR>    For Each tempBlock In ThisDrawing.ModelSpace<BR>        Select Case tempBlock.ObjectName<BR>            Case "AcDbPdfReference"<BR>                'Traitement du chemin<BR>                'Supression du lecteur r:\ et substitution par<BR>                chemin = tempBlock.File<BR>                chemin = Right(chemin, Len(chemin) - 3)<BR>                chemin = racine & chemin<BR>                tempBlock.File = chemin<BR>            Case "AcDbRasterImage"<BR>                'Traitement du chemin<BR>                'Supression du lecteur r:\ et substitution par<BR>                chemin = tempBlock.ImageFile<BR>                chemin = Right(chemin, Len(chemin) - 3)<BR>                chemin = racine & chemin<BR>                tempBlock.ImageFile = chemin<BR>        End Select<BR>    Next<BR>    'On scan l'espace papier<BR>    For Each ob In ThisDrawing.PaperSpace<BR>        Select Case tempBlock.ObjectName<BR>            Case "AcDbPdfReference"<BR>                'Traitement du chemin<BR>                'Supression du lecteur r:\ et substitution par<BR>                chemin = tempBlock.File<BR>                chemin = Right(chemin, Len(chemin) - 3)<BR>                chemin = racine & chemin<BR>                tempBlock.File = chemin<BR>            Case "AcDbRasterImage"<BR>                'Traitement du chemin<BR>                'Supression du lecteur r:\ et substitution par<BR>                chemin = tempBlock.ImageFile<BR>                chemin = Right(chemin, Len(chemin) - 3)<BR>                chemin = racine & chemin<BR>                tempBlock.ImageFile = chemin<BR>        End Select<BR>    Next<BR>    chemin = ""<BR>    chemin1 = ""<BR>    racine = "D:\"<BR>    'On scan les xref DWG, DXF, DGN<BR>    For Each tempBlock2 In ThisDrawing.Blocks<BR>        If (tempBlock2.IsXRef) Then<BR>            chemin1 = tempBlock2.Path<BR>            'Traitement du chemin<BR>            'Supression du lecteur r:\ et substitution par<BR>            chemin = Right(chemin1, Len(chemin1) - 3)<BR>            chemin = racine & chemin<BR>            tempBlock2.Path = chemin<BR>            TempBlockImbr = tempBlock2.XRefDatabase<BR>            'Teste par récurence les sous entité<BR>            'For Each tempBlock In TempBlockImbr<BR>            '    If chemin1 = chemin Then<BR>            '        msg = "Vous pouvez enregistrer le dessin et le fermer"<BR>            '        MsgBox msg<BR>            '        Exit Sub<BR>            '    End If<BR>            '    Set AcadApp = New AcadApplication<BR>            '    AcadApp.Visible = True<BR>            '    Set AcadPlan = AcadApp.Documents.Open(chemin1)<BR>            '    'Rend AutoCAD visible<BR>            '    XREF3_Path<BR>            '    'Set AcadApp = Nothing<BR>            '    'Set AcadPlan = Nothing<BR>            '    'AcadPlan.Save 'Sauvegarde le dessin<BR>            '    'AcadPlan.Close 'Ferme le dessin<BR>            '    'AcadApp.Quit 'Ferme l'application AutoCAD<BR>            'Next<BR>            'If q = True Then<BR>            '    Exit For<BR>            'End If<BR>        End If    Next<BR>    msg = "Vous pouvez enregistrer le dessin et le fermer 1"<BR>    MsgBox msg<BR>End Sub<BR>

 

Est-il possible d'appliquer cette routine à l'ensemble des fichiers .dwg dont les noms et les chemins sont répertoriés dans Excel, ou dans Acces, à partir d'Excel ou d'Acces.

 

Sauriez vous comment peux -t-on ouvrir un dessin autocad et lui appliquer la routine ci dessus.

 

Je vous remercie par avance.

Cordialement.

[didier]

Coucou

 

la commande REDIR le fera efficacement

ensuite on la colle dans un script et on traite tout un disque.

 

amicalement

[stugeol]

peux tu m'en dire un peux plus sur cette comande REDIR.

[stugeol]

Je viens de jeter un oeuil dan l'aide des express tools, cette commande me conviens et me permet d'alléger mon code VBA et de recréer tous les liens.

Maintenant comment faire en VBA pour ouvrir un dessin et lui appliquer une routine.

Le code suivant suffirait-il :

           Set AcadApp = New AcadApplication
           AcadApp.Visible = True
           Set AcadPlan = AcadApp.Documents.Open("Chemin du fichier à ouvrir")
           Rend AutoCAD visible
               'Execution de la commande redir
           AcadPlan.Save 'Sauvegarde le dessin
           AcadPlan.Close 'Ferme le dessin
           AcadApp.Quit 'Ferme l'application AutoCAD
           Set AcadApp = Nothing
           Set AcadPlan = Nothing

[stugeol]

Merci Didier pour la découverte de la comande REDIR.

 

Je viens de tester la tester sur un dessin.

Je dois renseigner le chemin existant (Chemin1) puis le chemin de remplacement (Chemin2)

 

par exemple pour une xref : c:\dessin\

puis le remplacer par d:\srep1\srep2\dessin\

 

Comment lister tous les chemins des fichiers attachés au dessin?

 

Afin de mieux comprendre voici mon idé :

Sous Excel :

1-lister le chemin de tous les dessins sur le serveur

2-ouvrir chaque dessin

3-lister les chemins de tous les fichier attacher (chemin1)

4-modifier les chemin1 (chemin2)

5-pour chaque chemin1

5.1 -lancer la commande redir avec comme arguement chemin1, chemin2

6-enregistre le dessin

7-fermer le dessin

8-traiter le fichier suivant.

 

Pour l'instant je coince sur la partie 3.

Si vous avez des idées, je suis preneur.

Cordialement.

[stugeol]

Bon, petit à petit j'avance dans ma quète.

 

J'ai tenté d'ouvrir le Lisp REDIR pour le modifier afin de l'adapter au problème, mais je ne maîtrise pas du tout ce langage pour modifier au bon endroit le code...

 

Pour lister le chemin de toutes les xref (dessin, image...) j'utilise la collection FileDependencies :

 

Sub essait2()
Dim Files As AcadFileDependencies
Dim File As AcadFileDependency
Dim msg, chemin As String
msg = ""
Set Files = ThisDrawing.FileDependencies
For Each File In Files
           chemin = File.FullFileName
           'traitement du chemin
           'lancer la commande REDIR
           File.FullFileName = (chemin)
           MsgBox chemin
NextEnd Sub

 

Maintenant il me reste à résoudre le listing des chemin des fichier de formes (.shx).

Si vous avez des idées en VBA je suis preneur.

Cordialement.

[didier]

coucou

 

tu aimes perdre du temps on dirait (hihihi)

 

note ton nouveau chemin en copiant l'adresse dans l'explorer

(Ctrl+C dans la barre d'adresse)

 

lance la commande REDIR

première réponse *

(le caractère étoile qui est un générique du DOS)

deuxième réponse

Ctrl+V (coller le nouveau chemin)

 

c'est fini

toutes les images, toutes les xrefs sont redirigées

pas de VBA, pas de LISP, pas de DIESEL, rien.

 

tu mets ces quelques lignes dans un script

et tu peux traiter tout un répertoire.

 

en dix minutes et tu peux traiter l'ensemble de tes fichiers

je l'ai fait des dizaines de fois sur des serveurs entiers.

 

amicalement

[stugeol]

Coucou Didier,

 

J'ai tester la commande REDIR

J'ouvre le dessin je lance la commande REDIR

Option * pour tous les fichiers

Ancien chemin R:\etudes\89 Divers\BOUD-08-0024 CC Avallonnais - Parcs d'Activités\05_DCE\Doc de travail\Dessin\00.Fdp

Nouveau chemin S:\EFR\EAM\etudes\89 Divers\BOUD-08-0024 CC Avallonnais - Parcs d'Activités\05_DCE\Doc de travail\Dessin\00.Fdp

 

Dans un dessin j'ai 11 sous répertoires, je dois aussi remplacer les chemins des bibiliothéques 20 sous répertoires soit 31 chemins à redéfinir pour un dessin.

Je cherche donc un moyen d'automatiser la tache en remplassant le nom du lecteur r:\ q:\ w:\.... par S:\EFR\EAM\

Et biens sur des centaines de dessin à traiter...

 

Didier, si tu as un exemple de script je suis preneur.

Cordialement.

[didier]

Coucou

 

tu en as donc bien des sous-répertoire ...

tu ne dois répondre à REDIR

que ce que tu dois changer

 

par exemple

changer : R:\etudes\89 Divers\BOUD-08-0024 CC Avallonnais - Parcs d'Activités\05_DCE\Doc de travail\Dessin\00.Fdp

par S:\EFR\EAM\etudes\89 Divers\BOUD-08-0024 CC Avallonnais - Parcs d'Activités\05_DCE\Doc de travail\Dessin\00.Fdp

 

dans redir tu réponds

R:\

puis

S:\EFR\EAM\

 

et c'est fini

 

il faut connaître les génériques du DOS ça aide

utilise l'étoile pour commencer tu m'en diras des nouvelles

 

amicalement

[stugeol]

Ok Didier, c'est le même principe que rechercher/remplacer dans le gestionnaire de reférence.

Plus besoin de se casser la tête pour lister les fichiers liés. Du coup les points 3, 4 et 5 sont résolu.

Je vais donc suivre se principe :

dans Excel :

1- Lister tous les fichiers autocad

2-Ouvrir un fichier autocad

2.1-Lancer la commande REDIR pour chaque ancien lecteur (R:\....) et remplacer le lecteur par (S:\EFR\EAM\)

3-Fermer le fichier autocad

4-Passer au fichier suivant jusqu'au dernier de la liste.

 

Un grand merci Didier pour tes lumières sur la comande REDIR.

Je vais pouvoir attaquer le code sous Excel (moins de 65000 fichier à lister) , et le tester.

 

Je vous tiens au courant.

Et encore un Grand merci Didier pour tes lumières.:)

[didier]

coucou

 

je t'en prie, je me suis inscrit pour échanger

c'est ce que nous faisons.

 

amicalement

[stugeol]

Voici une solution qui fonctionne et qui peux être améliorée voici le principe :

-Le programme parcours tous les fichiers et teste l'extension des fichiers

-Si l'extention est dwg alors

-Ouverture du dessin

-Exécution des commande REDIR

-Sauvgarde du dessin

-Fermeture du dessin

 

Il suffit d'ouvrir autocad, d'ouvrir un dessin vide, et de lancer la routine

 

Voici le Code :

 

 

Sub ModXref()
Dim fso As FileSystemObject
Dim dossier As Folder
Dim sousdossier As Folder
Dim fichier As File
   Set fso = New FileSystemObject
   Set dossier = fso.GetFolder("G:\BCAD-10-000X- ST GERMAIN TROYES")
   scan dossier
End Sub
Public Sub scan(ByVal dossier As Folder)
Dim fso As FileSystemObject
   For Each fichier In dossier.Files
       'Teste l''extension du fichier si dwg alors traitement du fichier
       If Right(fichier, 3) = "dwg" Then
           'Ouvre un dessin
           ThisDrawing.Application.Documents.Open fichier
           'Exécute les commandes dans REDIR actif
           ThisDrawing.SendCommand "REDIR" & vbCr & "R:\" & vbCr & "S:\EFR\EAM\etudes\" & vbCr
           ThisDrawing.SendCommand "REDIR" & vbCr & "M:\" & vbCr & "S:\EFR\EAM\donnees\" & vbCr
           ThisDrawing.SendCommand "REDIR" & vbCr & "w:\" & vbCr & "S:\EFR\EAM\outils\" & vbCr
           'Ferme le dessin
           ThisDrawing.Application.ActiveDocument.Save
           ThisDrawing.Application.ActiveDocument.Close
       End If
   Next
   For Each sousdossier In dossier.SubFolders
       'Debug.Print sousdossier
       scan sousdossier
   Next
End Sub

 

Le fait d'ouvrir chaque dessin peut être long...

J'éspère que ce code dépanera un bon nombre de personne. Je suis ouvert à toutes remarques pour l'améliorer.

 

Encore merci Didier pour ton aide.