Hachures sans contour VBA

[Yecheon]

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 

[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.