Bonjour,
C'est le mieux que je puisse faire avec ton dessin actuel...
Tu trouveras ci-joint un fichier où :
J'ai généré des polyligne sur les contours de hachure via HATCHGENERATEBOUNDARY
J'ai copié les polylignes générées dans un nouveau fichier
J'ai simplifié les polylignes (option AutoCAD MAP) via "Map - Dessin" / "Outils", "Généraliser les polylignes"
Puis à l'aide d'un programme VB.NET j'ai généré des polylignes pour toutes les polylignes possédant 4 coins (rectangle)
Code Vb.NET:
'Commande AJOUTER_POL_CENTRE_HACHURE
<CommandMethod("AJOUTER_POL_CENTRE_HACHURE", "AJOUTER_POL_CENTRE_HACHURE", CommandFlags.Modal + CommandFlags.UsePickSet)>
Public Sub AJOUTER_POL_CENTRE_HACHURE()
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim db As Database = doc.Database
Dim FpDWG As String = doc.Name
Dim lName As String = "Model"
Dim acpoly As Polyline = Nothing
Try
Autodesk.AutoCAD.ApplicationServices.Application.SetSystemVariable("ctab", lName)
CREER_CALQUE("POL_CENTRALE", 3)
Dim tr As Transaction = db.TransactionManager.StartTransaction()
Using tr
Dim bt As BlockTable = TryCast(tr.GetObject(db.BlockTableId, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForRead), BlockTable)
Dim btfw As BlockTable = TryCast(tr.GetObject(db.BlockTableId, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForWrite), BlockTable)
For Each id As ObjectId In bt
Dim btr As BlockTableRecord
btr = TryCast(tr.GetObject(id, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForWrite), BlockTableRecord)
If btr.IsLayout Then
Dim lid As ObjectId = btr.LayoutId
Dim lt As Layout = TryCast(tr.GetObject(lid, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForWrite), Layout)
Dim objsBlk As New List(Of ObjectId)()
Dim objsPol As New List(Of ObjectId)()
If lt.LayoutName <> lName Then
Continue For
Else
Dim etypePol As RXClass = RXObject.GetClass(GetType(Polyline))
For Each eid As ObjectId In btr
Dim ent As Entity
Dim Pol As Polyline
ent = TryCast(tr.GetObject(eid, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForWrite), Entity)
If eid.ObjectClass.IsDerivedFrom(etypePol) Then
Pol = ent
objsBlk.Add(eid)
acpoly = DirectCast(ent, Polyline)
If acpoly.NumberOfVertices = 4 Then
Dim ptA, ptB, ptC, ptD As Point2d
ptA = acpoly.GetPoint2dAt(0)
ptB = acpoly.GetPoint2dAt(1)
ptC = acpoly.GetPoint2dAt(2)
ptD = acpoly.GetPoint2dAt(3)
Dim dist1, dist2 As Double
dist1 = CALCUL_DISTANCE(ptA.X, ptA.Y, ptB.X, ptB.Y)
dist2 = CALCUL_DISTANCE(ptB.X, ptB.Y, ptC.X, ptC.Y)
Dim Longueur, Largeur As Double
Dim ptC1, ptC2 As Point2d
If dist1 > dist2 Then
Longueur = dist1
Largeur = dist2
ptC1 = New Point2d(ptA.X + (ptD.X - ptA.X) / 2, ptA.Y + (ptD.Y - ptA.Y) / 2)
ptC2 = New Point2d(ptB.X + (ptC.X - ptB.X) / 2, ptB.Y + (ptC.Y - ptB.Y) / 2)
Else
Longueur = dist2
Largeur = dist1
ptC1 = New Point2d(ptA.X + (ptB.X - ptA.X) / 2, ptA.Y + (ptB.Y - ptA.Y) / 2)
ptC2 = New Point2d(ptD.X + (ptC.X - ptD.X) / 2, ptD.Y + (ptC.Y - ptD.Y) / 2)
End If
Dim pol2 As New Polyline
pol2.AddVertexAt(0, New Point2d(ptC1.X, ptC1.Y), 0, 0, 0)
pol2.AddVertexAt(1, New Point2d(ptC2.X, ptC2.Y), 0, 0, 0)
pol2.Layer = "POL_CENTRALE"
btr.AppendEntity(pol2)
tr.AddNewlyCreatedDBObject(pol2, True)
End If
End If
Next 'eid
End If
End If
Next 'id
tr.Commit()
tr.Dispose()
End Using 'tr
Catch ex As System.Exception
MsgBox(ex.ToString)
ed.WriteMessage(vbLf & ex.Message & vbLf & ex.StackTrace)
End Try
End Sub
'Calcul la distance entre deux points
Public Shared Function CALCUL_DISTANCE(Xa As Double, Ya As Double, Xb As Double, Yb As Double) As Double
Return Math.Sqrt((Xb - Xa) ^ 2 + (Yb - Ya) ^ 2)
End Function
A+ Yoan
Yoan AUBRY
