Hachure de MLINE

[tyrese69_]

Bonsoir à tous,

 

Aprés diverses tentatives en lisp, je me suis tourner vers le VBA !

Cette fois j'ai bien une hachure mais elle ne correspond pas a ma MLINE

 

Il doit falloir réorganiser les points différement !

 

(ps: juste pour info, le temps de développemnt et debbugage, a été divisé par 4)

Daniel OLIVES

 

 
Sub HatchMLine()

   ' * * * * * * * * * * * * * * * * * * * * * * * * * * * 10
   ' Traitement de par sélection de la couche à traiter
   '---------------------------------------------------------
   Dim ent1 As AcadEntity
   Dim ent2 As AcadEntity
   Dim entXref As AcadExternalReference
   Dim entBlock As AcadBlock
   Dim entNestedBlock As AcadBlockReference
   Dim objBlock As AcadBlockReference
   Dim ssSet As AcadSelectionSet
   Dim FilterType(1) As Integer
   Dim FilterData(1) As Variant
   Dim obj As AcadEntity
   Dim strOName As String
   Dim tmps As String

   Dim Cpt1, MaxCpt1, m As Integer        ' compteurs

   Set objDict = ThisDrawing.Dictionaries.Add("Dict1")
   Set ssSet = vbdPowerSet("BlockCount")
   
   ' Code DXF 0 = objets insérés
   FilterType(0) = 0
   FilterData(0) = "MLINE"

   ' Code DXF 67 = Espace papier (1) ou objet (0)
   FilterType(1) = 67
   FilterData(1) = 0
   
   ssSet.SelectOnScreen FilterType, FilterData

   m = ssSet.Count
   
  
   If ssSet.Count <> 0 Then
       Dim CoucheSel As String
       CoucheSel = ssSet.item(0).Layer
   End If
   ' * * * * * * * * * * * * * * * * * * * * * * * * * * * 11
   ' Traitement des données des MultiLignes
   ' et stockage dans tableau "TblMLine"
   '-------------------------------------
   Dim ssMLines As AcadSelectionSet
   ' (1) pour deux valeurs
   Dim DxfCode(1) As Integer
   Dim DxfData(1) As Variant
   Dim oMLine As AcadMLine
   Dim XMLine As AcadMLine
   Dim NbMLine As Integer
   
   Dim TblCoordMLine As Variant
   Dim loBound As Long
   Dim upBound As Long
   Dim LongMLine As Double
   Dim CoordXMLine As Double
   Dim CoordYMLine As Double
   Dim StMLineCdc100 As Boolean
   Dim n As Integer
   Dim Cumul As Double
   
   StMLineCdc100 = MlineStyleExists("Cdc100")
   
   For Each ssMLines In ThisDrawing.SelectionSets
       If ssMLines.name = "ssMLines" Then
           ssMLines.Delete
           Exit For
       End If
   Next ssMLines
   
   Set ssMLines = ThisDrawing.SelectionSets.Add("ssMLines")
   
   DxfCode(0) = 0
   DxfData(0) = "MLINE" '"LINE,LWPOLYLINE,POLYLINE,MLINE"
   DxfCode(1) = 8
   DxfData(1) = CoucheSel
   
   ssMLines.Select acSelectionSetAll, , , DxfCode, DxfData
   
   NbMLine = ssMLines.Count
   If NbMLine = 0 Then MsgBox "Il n'y a pas de MultiLignes dans ce dessin !": GoTo SuiteFin

   For Each oMLine In ssMLines
     ' Tableau d'entité qui sera passé à la méthode AppendOuterLoop
     ' de l'objet hachures
     Dim ObjetFrontiere(0 To 0) As AcadEntity

     ' Polyligne qui va servir de frontière aux hachures
     Dim ObjetPolyligne As Object
     
     ' Objet hachures
     Dim ObjetHachures As AcadHatch

     Dim outerLoop() As Double
     
     outerLoop = oMLine.Coordinates
     
     Set ObjetPolyligne = ThisDrawing.ModelSpace.AddPolyline(outerLoop)
     ' On la ferme
     ObjetPolyligne.Closed = True
     
     ' On crée la hachure
     Set ObjetHachures = ThisDrawing.ModelSpace.AddHatch(acHatchPatternTypePreDefined, "ANSI31", True)

     ' On place la polyligne dans le tableau d'entités AutoCAD
     Set ObjetFrontiere(0) = ObjetPolyligne
     
     ' On défini la frontière de l'objet hachures
     ObjetHachures.AppendOuterLoop (ObjetFrontiere)
     
     ' On change l'échelle d'hachurage
     ObjetHachures.PatternScale = 0.01
     
     ' On demande à AutoCAD de calculer les intersections des hachures
     ' et de la frontière
     ObjetHachures.Evaluate

   Next
   
SuiteFin:

End Sub

[tyrese69_]

Bonjour à tous,

 

La nuit porte conseil. En regardant la liste des coordonnées de la multiligne j'ai remarqué bien sur que c'était une ligne eet non pas un contour ! Il faut donc convertir en fonction du style, la ligne en contour région ou polyligne et dans ce cas la fonction de hachurage sera possible.

 

Mon problème vient du fait que en lisp de base on peut hachurer l'entité précédente via une commande "hachure" ("_-hatch") alors que ne visual (vla) ou vba (valx) les chose sont diffréntes.

 

IL aurait fallu que je vérifie via un dump les entités utilisés pour ne pas perdre trop de temps de programmation, mais cela a été trés formateur.

 

Je cherche donc maintenant à réaliser ma routine de conversion d'une MLIN en contour viable.

 

A+

 

Daniel OLIVES