Réunir les espaces papiers et objet

[winfield]

Bonsoir,

 

J'ai besoin d'accéder à des images pouvant être autant dans l'espace model que les espaces papiers (pour redéfinir les chemins).

Y aurait-il une syntaxe qui réunirait :

"Thisdrawing.ModelSpace" ET "Thisdrawing.PaperSpace" ?

 

Merci d'avance

[Pako]

Salut winfield,

 

Essaye ça : ICI

 

Il suffit d'ajouter un boucle pour traiter chaque objets (image) de la sélection !

 

En passant, il existe une commande nommée : _redir dans les Express Tools

qui fait aussi la job, pour les images, les xref(s), les shapes et les styles de text....

 

 

 

Bonne Chance !

 

 

[winfield]

Bonsoir

et merci, vais voir tout ça à tête reposé :D

[winfield]

Rebonsoir,

 

C'est loin d'être le top mais bon, c'est un début ;)

Et encore merci Pako, j'aurais pas pensé qu'une selection puisse s'étendre dans les 2 espaces de dessins.

 

Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Optional msg) As String

   Dim bInfo As BROWSEINFO
   Dim path As String
   Dim r As Long, x As Long, pos As Integer
   Dim Dossier As String
   bInfo.pidlRoot = 0&
   If IsMissing(msg) Then
       bInfo.lpszTitle = "Indiquez où se trouve les images."
   Else
       bInfo.lpszTitle = msg
   End If
       bInfo.ulFlags = &H1
       x = SHBrowseForFolder(bInfo)
       path = Space$(512)
       r = SHGetPathFromIDList(ByVal x, ByVal path)
   If r Then
       pos = InStr(path, Chr$(0))
       GetDirectory = Left(path, pos - 1)
       Dossier = GetDirectory '& "\"
   Else
       
   End If
End Function
Public Sub SelectImage()

'Ne fonctionne pas si l'image est dans un bloc
'Prochaine étape, régle  le prob ci-dessus
   Dim StrChemin As String
   Dim CheminRaster As String
   Dim Raster As AcadRasterImage
   Dim IntCodes(0) As Integer
   Dim VarValeurs(0) As Variant
   Dim ObjSelection As AcadSelectionSet
   Dim StrNomSelection As String
   
   StrNomSelection = "MaSelection"
   
   On Error Resume Next
   Set ObjSelection = ThisDrawing.SelectionSets.Add(StrNomSelection)
   If Err <> 0 Then
       Set ObjSelection = ThisDrawing.SelectionSets(StrNomSelection)
       Err.cler
       ObjSelection.Clear
   End If
   IntCodes(0) = 0: VarValeurs(0) = "IMAGE"
   ObjSelection.Select acSelectionSetAll, , , IntCodes, VarValeurs
   If ObjSelection Is Nothing Then
       MsgBox vbCr & "Aucun objet sélectionné."
       Exit Sub
   Else
       StrChemin = GetDirectory
       aTrouver = "\"
       For Each Raster In ObjSelection
           CheminRaster = ""
           MyPos = ""
           NomFichier = ""
           CheminRaster = StrReverse(Raster.ImageFile)
           MyPos = InStr(1, CheminRaster, aTrouver, 1)
           NomFichier = Right(Raster.ImageFile, MyPos - 1)
           Raster.ImageFile = StrChemin & "\" & NomFichier
       Next
   End If
   ObjSelection.Delete
   ThisDrawing.Regen True
End Sub

 

Désolé mais j'ai pas réussi à attraper le nom du fichier avec son extension, c'est pour ça que je fais un reverse :)

 

 

[Edité le 6/12/2005 par winfield]

[Pako]

Salut,

 

J'ai testé ton code à plusieurs reprise, et après réflexion :

 

Au lieu d'utiliser la propriété .ImageFile ,

j'ai essayé avec .Name & .ImageFile (pour le type de fichier).

 

Et ça semble fonctionné.....

 

Voici le bout à modifier :

 

 

Else
StrChemin = GetDirectory
aTrouver = "_"
For Each Raster In ObjSelection
typeRaster = ""
NomFichier = ""
typeRaster = Right(Raster.ImageFile, 4)
MyPos = InStr(1, Raster.Name, aTrouver, 1)
NomFichier = Left(Raster.Name, MyPos - 1)
Raster.ImageFile = StrChemin & "\" & NomFichier & typeRaster
Next
End If

 

ps. J'ai bien ta function "Function GetDirectory(Optional msg) As String",

est-ce que je peux partager ton code sur www.acadtuning.com, mon site perso !

 

amicalement,

 

 

 

 

 

[winfield]

Re,

La function n'est pas du tout mais pas du tout de moi, je l'ai trouvé je ne sais plus où au hasard de mes recherches sur le web. Du coup peut-être que tu peux le mettre sur AcadTuning en citant un Bel Inconnu ?! :)

[Pako]

Pis ça fonctionnes-tu ?

 

Est-ce que le type d'attachement de l'image (FULL PATH, RELATIVE PATH, NO PATH),

peux avoir un bug avec ta routine ?

 

Répertoire choisi par l'usager !

 

 

amicalement,

 

 

 

 

 

 

 

[Edité le 7/12/2005 par Pako]

[winfield]

Bonsoir,

Bonne question et merci de l'avoir posé :cool:

 

Là tu vas un "pont trop loin" et trop vite pour moi. Tu sais ça ne fait que 2 ou 3 mois que je me suis mis au vba, alors j'espère que tu comprends que certaines choses ("beaucoups", pour être honnête) m'échappe encore. Mais je vais regarder ça, on ne sait jamais.....