Sub GenSection()
Dim x3DSolid As Acad3DSolid
ThisDrawing.Utility.GetEntity x3DSolid, basePt, "Укажите 3D-тело"
Dim PlaneVector(0 To 2) As Double
PlaneVector(0) = 0: PlaneVector(1) = 0: PlaneVector(2) = 1
'pt1 = ThisDrawing.Utility.GetPoint(, "Укажите первую точку сечения: ")
'pt2 = ThisDrawing.Utility.GetPoint(, "Укажите вторую точку сечения: ")
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
pt1(0) = -1000#: pt1(1) = -1000#: pt1(2) = 0#
pt2(0) = 1000#: pt2(1) = 1000#: pt2(2) = 0#
Dim sec As AcadSection
Dim ss As AcadSectionSettings
Set sec = ThisDrawing.ModelSpace.AddSection(pt1, pt2, PlaneVector)
With sec
.TopHeight = 3
.BottomHeight = 1
.State = acSectionStatePlane
Set ss = .Settings
End With
With ss
.CurrentSectionType = acSectionType2dSection
End With
Dim acSectionTypeSettings As AcadSectionTypeSettings
Set acSectionTypeSettings = ss.GetSectionTypeSettings(acSectionType2dSection)
With acSectionTypeSettings
.ForegroundLinesVisible = True
.BackgroundLinesHiddenLine = True
.IntersectionFillHatchPatternName = "ANSI31"
' Ну и так далее
End With
sec.GenerateSectionGeometry x3DSolid, BoundaryObjs, FillObjs, BakcGroundObjs, ForegroundObjs, CurveTangencyObjs
End Sub