Yecheon

Réponse trouvée après acharnement, c'était pourtant tout con mais comme je débute : Sub hachures() Dim AcadApp As AcadApplication, AcadPlan As AcadDocument 'Création de l'objet AutoCAD dans Excel : Set AcadApp = AcadApplication AcadApp.Visible = True 'Set AcadPlan = AcadApp.Documents.Open("D:\Temp\test.dwg") Set AcadPlan = AcadApp.ActiveDocument ' Selection du calque AcadPlan.SendCommand "-calque" & vbCr & "ch" & vbCr & "Brouillon" & vbCr & vbCr ' Traçage de la polyligne Dim Pline9 As Object Dim Pol9(15) As Double Pol9(0) = Cells(53, 2): Pol9(1) = Cells(53, 3) Pol9(2) = Cells(54, 2): Pol9(3) = Cells(54, 3) Pol9(4) = Cells(55, 2): Pol9(5) = Cells(55, 3) Pol9(6) = Cells(56, 2): Pol9(7) = Cells(56, 3) Pol9(8) = Cells(57, 2): Pol9(9) = Cells(57, 3) Pol9(10) = Cells(52, 2): Pol9(11) = Cells(52, 3) Pol9(12) = Cells(51, 2): Pol9(13) = Cells(51, 3) Pol9(14) = Cells(58, 2): Pol9(15) = Cells(58, 3) Set Pline9 = AcadPlan.ModelSpace.AddLightWeightPolyline(Pol9) Pline9.Closed = True Pline9.Update Dim Frontiere9(0 To 0) As Object Set Frontiere9(0) = Pline9 ' Selection du calque AcadPlan.SendCommand "-calque" & vbCr & "ch" & vbCr & "Hachure" & vbCr & vbCr ' Création de la hachure Dim ObjetHachures6 As Object Set ObjetHachures6 = AcadPlan.ModelSpace.AddHatch(acHatchPatternTypePreDefined, "SOLID", True) ObjetHachures6.AppendOuterLoop (Frontiere9) ObjetHachures6.PatternScale = 0.01 ObjetHachures6.Evaluate AcadPlan.SendCommand "Hatchtoback" & vbCr & vbCr Pline9.Delete ' --- Set Ligne = Nothing Set AcadApp = Nothing Set AcadPlan = Nothing End Sub Pour ceux que ça pourrait aider, bonne journée.

Bonjour tout le monde, Voilà je me lance dans la VBA et après de nombreuses recherches je reste bloqué. J'aimerai pouvoir créer une hachure grâce à une polyligne, et suprimer la polyligne crée pour la hachure. Alors je ne sais pas si il est possible de créer une frontière sans tracer la Pligne sur autocad (mais essais on été vain). Sinon d'utiliser une selection pour lancer une sendcommand "delete", sauf que je n'ai pas trouvé le moyen de selectionner ma polyligne sans passer par le "selectonscreen". Ca va faire 8h que je cherche une solution et ça ne me mène nulle part. Lorsque je lance ce code tout se déroule sans problème, sauf que ma polyligne est encore présente... Merci à ceux qui prendrons le temps de m'aider Sub hachures() Dim AcadApp As AcadApplication, AcadPlan As AcadDocument 'Création de l'objet AutoCAD dans Excel : Set AcadApp = AcadApplication AcadApp.Visible = True 'Set AcadPlan = AcadApp.Documents.Open("D:\Temp\test.dwg") Set AcadPlan = AcadApp.ActiveDocument ' Selection du calque AcadPlan.SendCommand "-calque" & vbCr & "ch" & vbCr & "Brouillon" & vbCr & vbCr ' Traçage de la polyligne Dim Pline9 As Object Dim Pol9(15) As Double Pol9(0) = Cells(53, 2): Pol9(1) = Cells(53, 3) Pol9(2) = Cells(54, 2): Pol9(3) = Cells(54, 3) Pol9(4) = Cells(55, 2): Pol9(5) = Cells(55, 3) Pol9(6) = Cells(56, 2): Pol9(7) = Cells(56, 3) Pol9(8) = Cells(57, 2): Pol9(9) = Cells(57, 3) Pol9(10) = Cells(52, 2): Pol9(11) = Cells(52, 3) Pol9(12) = Cells(51, 2): Pol9(13) = Cells(51, 3) Pol9(14) = Cells(58, 2): Pol9(15) = Cells(58, 3) Set Pline9 = AcadPlan.ModelSpace.AddLightWeightPolyline(Pol9) Pline9.Closed = True Pline9.Update ' Selection du calque AcadPlan.SendCommand "-calque" & vbCr & "ch" & vbCr & "Hachure" & vbCr & vbCr ' Création de la hachure Dim Frontiere9(0 To 0) As Object Set Frontiere9(0) = Pline9 Dim ObjetHachures6 As Object Set ObjetHachures6 = AcadPlan.ModelSpace.AddHatch(acHatchPatternTypePreDefined, "SOLID", True) ObjetHachures6.AppendOuterLoop (Frontiere9) ObjetHachures6.PatternScale = 0.01 ObjetHachures6.Evaluate AcadPlan.SendCommand "Hatchtoback" & vbCr & vbCr ' Création de l'entité selectionné Dim Objentit As AcadEntity Dim ObjSelection As AcadSelectionSet Dim StrNomSelection As String StrNomSelection = "PLine9" On Error Resume Next Set ObjSelection = AcadPlan.SelectionSets(StrNomSelection) If Err <> 0 Then Err.Clear Else ObjSelection.Delete End If Set ObjSelection = AcadPlan.SelectionSets.Add(StrNomSelection) ' Suppression de la sélection Set ObjSelection = AcadPlan.ActiveSelectionSet(StrNomSelection) AcadPlan.SendCommand "delete" & vbCr & vbCr AcadPlan.Regen acActiveViewportC ' --- Set Ligne = Nothing Set AcadApp = Nothing Set AcadPlan = Nothing End Sub