<CommandMethod("convReg")>
Public Sub convReg()
Dim acDoc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument ' открываем базу данных чертежа
Dim ed As Editor = acDoc.Editor
Dim db As Database = acDoc.Database
Dim tr As Transaction = db.TransactionManager.StartTransaction()
Dim acBlkTbl As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
Dim acBlkTblRec As BlockTableRecord = tr.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
Using tr
Try
'=============================================================
'выбираем трассу
Dim pEntRes As PromptEntityResult = ed.GetEntity("Выберите полосу отвода: ")
Dim parentEnt As Autodesk.AutoCAD.DatabaseServices.Entity = tr.GetObject(pEntRes.ObjectId, OpenMode.ForRead)
If TypeOf parentEnt Is Autodesk.AutoCAD.DatabaseServices.Polyline Then
Dim parentPline As Autodesk.AutoCAD.DatabaseServices.Polyline = parentEnt
Dim tempCollection As DBObjectCollection = New DBObjectCollection()
tempCollection.Add(parentPline)
Dim parentRegionCollection As DBObjectCollection = New DBObjectCollection()
parentRegionCollection = Region.CreateFromCurves(tempCollection)
If parentRegionCollection.Count > 0 Then
Dim parentRegion As Region = parentRegionCollection.Item(0)
If parentRegion.Area > 0 Then
'выбираем участки
Dim acSSPrompt As PromptSelectionResult = acDoc.Editor.GetSelection()
If acSSPrompt.Status = PromptStatus.OK Then
Dim acSSet As SelectionSet = acSSPrompt.Value
For Each acSSObj As SelectedObject In acSSet
If Not IsDBNull(acSSObj) Then
Dim childEnt As Autodesk.AutoCAD.DatabaseServices.Entity = tr.GetObject(acSSObj.ObjectId, OpenMode.ForRead)
If Not IsDBNull(childEnt) Then
If TypeOf childEnt Is Autodesk.AutoCAD.DatabaseServices.Polyline Then
If parentRegion.Area = 0 Then
tempCollection = New DBObjectCollection()
tempCollection.Add(parentPline)
parentRegionCollection = New DBObjectCollection()
parentRegionCollection = Region.CreateFromCurves(tempCollection)
If parentRegionCollection.Count > 0 Then
parentRegion = parentRegionCollection.Item(0)
End If
End If
Dim tempChildCollection As DBObjectCollection = New DBObjectCollection()
tempChildCollection.Add(childEnt)
Dim childCollection As DBObjectCollection = New DBObjectCollection()
childCollection = Region.CreateFromCurves(tempChildCollection)
If childCollection.Count > 0 Then
Dim childRegion As Region = childCollection.Item(0)
If childRegion.Area > 0 Then
childRegion.BooleanOperation(BooleanOperationType.BoolIntersect, parentRegion)
Dim points As Point2d() = Nothing
Using brep = New Autodesk.AutoCAD.BoundaryRepresentation.Brep(childRegion)
points = brep.Edges.[Select](Function(e) e.Vertex1.Point.Convert2d(New Plane)).ToArray()
End Using
Dim normal = childRegion.Normal
Using pline = New Polyline(points.Length)
For i As Integer = 0 To points.Length - 1
pline.AddVertexAt(i, points(i), 0.0, 0.0, 0.0)
Next
pline.Closed = True
pline.Normal = normal
Dim curSpace = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
curSpace.AppendEntity(pline)
tr.AddNewlyCreatedDBObject(pline, True)
End Using
End If
End If
End If
End If
End If
Next
End If
End If
End If
End If
Catch ex As System.Exception
End Try
tr.Commit()
End Using
End Sub
