LimsWolf

Ah oui pas faux ! Merci, Résolu

Oh ça marche !! Merci Beaucoup. c'est FilterType et pas FiltresType, ainsi que FiltreData et non pas FiltresData Sub ChoixDeZoneMultiReseaux_Click() ''''''''''''''''''''''''''''''''''''''''''''' ZONES MULTI R2SEAUX ''''''''''''''''''''''''''''''''''''''''''''''''' Dim FilterType(1) As Integer Dim FilterData(1) As Variant Dim FiltersType, FiltersData As Variant Dim G0 As String Dim memtp As String Dim NewZone As String Dim Nzone As String Nzone = Right(ComboBox1, 2) NewZone = ThisWorkbook.Path & "\Zones\" & Nzone & "_" & TextBox1 & ".dwg" Sheets("Divers").Unprotect Sheets("Divers").Range("I3") = TextBox1 Sheets("Divers").Protect If Par_zone = True Then memtp = Sheets("Travail").TextBox2.Value Set AcadDoc = GetObject(, "Autocad.application").Documents(memtp) Set AcadObj = GetObject(, "Autocad.application") Call SetForegroundWindow(FindWindowA(vbNullString, AcadObj.Caption)) AcadDoc.SendCommand ("(load " & (Chr(34)) & "cps" & (Chr(34)) & ") ") AcadDoc.SendCommand ("_pline ") AcadDoc.SendCommand ("cps d ") AcadDoc.SendCommand ("_pselect p " & (Chr(27))) Set objSelSet = AcadDoc.ActiveSelectionSet AcadDoc.Wblock NewZone, objSelSet OuvrirDessinAutocad (NewZone) Set AcadDoc = GetObject(, "Autocad.application").ActiveDocument Set AcadObj = GetObject(, "Autocad.application") CheminFichier = NewZone CalqueFichier = "0" Set SelectZone = AcadObj.ActiveDocument.SelectionSets.Add("SelectZone") FilterType(0) = 0 ' code DXF du type de l'objet FilterData(0) = "LWPOLYLINE" ' type de l'objet FilterType(1) = 8 ' code DXF du calque de l'objet FilterData(1) = "0" ' nom du calque SelectZone.Select acSelectionSetAll, , , FilterType, FilterData AcadDoc.SendCommand ("_pselect p ") AcadDoc.SendCommand ("extrim -999999,-999999 ") End If End Sub

ah non dsl je ne l'avez pas déclarée, bon cette partie la marche mais maintenent c'est la ligne SelectZone.Select acSelectionSetAll, , , FiltersType, FiltersData qui ne fonctionne pas.

J'ai testé, ça ne fonctionne pas j'ai un message d'erreur "l'indice n'appartient pas à la selection" sur la ligne FilterType(1) = 8 ' code DXF du calque de l'objet j'ai regarder là c'est le bon DXF

Merci, je vais tester prochainement

Bonjour, Mon petit bout de code permet à l'utilisateur de choisir une zone en créant son contour par polyligne. Tout les objets dans la zone et touchant la zone sont exporté en Wblock, le Wblock s'ouvre, le block se décompose. Mais je souhait maintement selectionner la polyligne que l'utilisateur à créée pour effectuer la fonction EXTRIM d'autocad et aussi supprimer cette polyligne, enfin cela je sais le faire. voici quelques semaines que je désespère à l'idée de pouvoir selectionner cette simple polyligne, qui se trouve seul dans le calque 0. j'ai esseyé le filtre mais, ça ne fonctionne pas. Où est mon erreur. Je souhait remplacer les commentaire par la selection de cette polyligne : Calque "0". Sub ChoixDeZoneMultiReseaux_Click() ''''''''''''''''''''''''''''''''''''''''''''' ZONES MULTI R2SEAUX ''''''''''''''''''''''''''''''''''''''''''''''''' Dim FilterType(0) As Integer Dim FilterData(0) As Variant Dim FiltersType, FiltersData As Variant Dim G0 As String Dim memtp As String Dim NewZone As String Dim Nzone As String Nzone = Right(ComboBox1, 2) NewZone = ThisWorkbook.Path & "\Zones\" & Nzone & "_" & TextBox1 & ".dwg" Sheets("Divers").Unprotect Sheets("Divers").Range("I3") = TextBox1 Sheets("Divers").Protect If Par_zone = True Then memtp = Sheets("Travail").TextBox2.Value Set AcadDoc = GetObject(, "Autocad.application").Documents(memtp) Set AcadObj = GetObject(, "Autocad.application") Call SetForegroundWindow(FindWindowA(vbNullString, AcadObj.Caption)) AcadDoc.SendCommand ("(load " & (Chr(34)) & "cps" & (Chr(34)) & ") ") AcadDoc.SendCommand ("_pline ") AcadDoc.SendCommand ("cps d ") AcadDoc.SendCommand ("_pselect p " & (Chr(27))) Set objSelSet = AcadDoc.ActiveSelectionSet AcadDoc.Wblock NewZone, objSelSet OuvrirDessinAutocad (NewZone) Set AcadDoc = GetObject(, "Autocad.application").ActiveDocument Set AcadObj = GetObject(, "Autocad.application") ' CheminFichier = NewZone ' CalqueFichier = "0" ' ' Set SelectZone = AcadObj.ActiveDocument.SelectionSets.Add("SelectZone") ' ' FilterType(0) = 8 ' FilterData(0) = NewZone ' FiltersType = FilterType ' FiltersData = FilterData ' SelectZone.SelectOnScreen acSelectionSetAll, , , FiltersType, FiltersData ' AcadDoc.SendCommand ("extrim ") End If End Sub Merci. si vous avez une idée...