Dim AcadApp As AcadApplication = Runtime.InteropServices.Marshal.GetActiveObject("AutoCAD.Application")
Dim AcadDoc As AcadDocument = AcadApp.ActiveDocument
Dim curves(0 To 1) As AcadEntity
' считываю данные из таблицы и создаю полилинию
Dim dblVertices((grdVal.Rows.Count - 1) * 2 - 1) As Double
For i = 0 To grdVal.Rows.Count - 2
dblVertices(i * 2) = grdVal.Rows(i).Cells(0).Value : dblVertices(i * 2 + 1) = grdVal.Rows(i).Cells(2).Value
Next
curves(0) = AcadDoc.ModelSpace.AddLightWeightPolyline(dblVertices)
' почему то для создания региона надо что бы было два примитива, поэтому отдельно создаю замыкающую линию
ReDim dblVertices(0 To 3)
dblVertices(0) = grdVal.Rows(0).Cells(0).Value
dblVertices(1) = grdVal.Rows(0).Cells(2).Value
dblVertices(2) = grdVal.Rows(grdVal.Rows.Count - 2).Cells(0).Value
dblVertices(3) = grdVal.Rows(grdVal.Rows.Count - 2).Cells(2).Value
curves(1) = AcadDoc.ModelSpace.AddLightWeightPolyline(dblVertices)
' создаю область из созданных полилиний
Dim regionObj As Object
regionObj = AcadDoc.ModelSpace.AddRegion(curves)
' задаю ось вращения
Dim axisStart As Object
Dim axisEnd As Object
axisStart = CreatePoint(0, 0, 0) ' Начало оси
axisEnd = CreatePoint(0, 1, 0) ' Конец оси
' угол вращения
Dim angle As Double
angle = Math.PI * 2
' создаю тело
Dim solidObj As Acad3DSolid
solidObj = AcadDoc.ModelSpace.AddRevolvedSolid(regionObj(0), axisStart, axisEnd, angle)
' область не может быть по оси Z поэтому созданное тело вращаю по оси Х
axisStart = CreatePoint(0, 0, 0) ' Начало оси
axisEnd = CreatePoint(1, 0, 0) ' Конец оси
solidObj.Rotate3D(axisStart, axisEnd, Math.PI * 0.5)
' удаляю примитивы, не могу выловить область, поэтому буду перебором удалять
curves(0).Delete()
curves(1).Delete()
' перебираю все примитывы для удаление области
' Loop through all the entities in the model space
Dim entity As Object
For Each entity In AcadDoc.ModelSpace
' Check if the entity is a region
If TypeOf entity Is AcadRegion Then
' Add the region to the collection of regions to delete
regionsToDelete.Add(entity)
End If
Next entity
' Loop through the collection of regions to delete and delete each region
Dim region As Object
For Each region In regionsToDelete
region.Delete
Next region
' Change the viewing direction of the viewport
Dim NewDirection(0 To 2) As Double
NewDirection(0) = -1 : NewDirection(1) = -1 : NewDirection(2) = 1
AcadDoc.ActiveViewport.Direction = NewDirection
AcadDoc.ActiveViewport = AcadDoc.ActiveViewport
AcadDoc.Regen(True)