[Богданов Вячеслав]

Здравствуйте, господа.
Я пишу скрипт на VB для автокада. Пока работал с 2D объектами (в програмистском значении сего слова) всё было просто. Но когда потребовалось нарисовать трехмерный усеченный скошеный конус... Полное фиаско. Насколько я смог понять, единственный способом построить трехмерную фигуру произвольной формы - это воспользоваться объектом 3DMesh. Возможно, всё не так уж и сложно, но пока непонятно в каком порядке должны следовать строки и колонки в NM-матрице. Самый принцип непонятен. Внутренняя логика. В то же время "в стандартной поставке Автокада есть несколько программ, написаных на языке AutoLISP, которые используя ранее рассмотренную команду 3dmesh, позволяют создавать ряд стандартных геометрических фигу" (цитата из книжки). Значит можно рисовать. Правда с Лиспом у меня никак. То есть я вообще не представляю что это такое.
Может быть у кого-нибудь есть листинг алгоритма рисования конуса или цилиндра или чего-нибудь круглого на Бейсике?

[{Smirnoff}]

А зачем 3DMesh? Так нужно? Вообще то есть стандартный метод постороения конуса в виде солида AddCone и пример в Help.

Код:

[Выделить все]

Sub Example_AddCone()
    ' This example creates a cone in model space.
   
    Dim coneObj As Acad3DSolid
    Dim radius As Double
    Dim center(0 To 2) As Double
    Dim height As Double
    
    ' Define the cone
    center(0) = 0#: center(1) = 0#: center(2) = 0#
    radius = 5#
    height = 20#
    
    ' Create the Cone (3DSolid) object in model space
    Set coneObj = ThisDrawing.ModelSpace.AddCone(center, radius, height)
    
    ' Change the viewing direction of the viewport to better see the cone
    Dim NewDirection(0 To 2) As Double
    NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
    ThisDrawing.ActiveViewport.direction = NewDirection
    ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
    ZoomAll
End Sub

Если надо усеченный конус, есть метод SliceSolid и пример:

Код:

[Выделить все]

Sub Example_SliceSolid()
    ' This example creates a box in model space.
    ' It then slices the box based on a plane
    ' defined by three points. The slice is returned
    ' as a 3Dsolid.
        
    Dim boxObj As Acad3DSolid
    Dim length As Double, width As Double, height As Double
    Dim center(0 To 2) As Double
    
    ' Define the box
    center(0) = 5#: center(1) = 5#: center(2) = 0
    length = 5#: width = 7: height = 10#
    
    ' Create the box (3DSolid) object in model space
    Set boxObj = ThisDrawing.ModelSpace.AddBox(center, length, width, height)
    
    ' Define the section plane with three points
    Dim slicePt1(0 To 2) As Double
    Dim slicePt2(0 To 2) As Double
    Dim slicePt3(0 To 2) As Double
    
    slicePt1(0) = 1.5: slicePt1(1) = 7.5: slicePt1(2) = 0
    slicePt2(0) = 1.5: slicePt2(1) = 7.5: slicePt2(2) = 10
    slicePt3(0) = 8.5: slicePt3(1) = 2.5: slicePt3(2) = 10
    
    ' slice the box
    Dim sliceObj As Acad3DSolid
    Set sliceObj = boxObj.SliceSolid(slicePt1, slicePt2, slicePt3, True)
    
    ' Change the viewing direction of the viewport
    Dim NewDirection(0 To 2) As Double
    NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
    ThisDrawing.ActiveViewport.direction = NewDirection
    ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
    ZoomAll
    
End Sub

[Богданов Вячеслав]

Спасибо за листинг, но конус должен быть не только усеченным. Он должен быть скошеным. То есть вершина и центр окружности основания конуса не лежат на одной прямой. Точнее сказать, вершина должна находится на линии перпендикулярной плоскости основания (круга) на расстоянии от центра равном радиусу окружности. Над краем круга, грубо говоря. Эдакая смесь цилиндра с конусом.

А зачем 3DMesh? Меньше ограничений. Единожды разобравшись можно создавать любые фигуры.

[Богданов Вячеслав]

Всё как всегда. Сам себе не поможешь, никто не поможет.
Выкладываю листинг. Авось кому сгодится. Сам вчера наваял.

Sub Circle_of_Mesh()
Const pi = 3.14159265
Dim Xc As Double 'х центра основания
Dim Yc As Double 'y центра
Dim L As Double ' высота или длина (как кому)
Dim Rc1 As Double ' радиус основания
Dim Rc2 As Double ' радиус вершины. Если 0, получится конус

Dim t As Double '
Dim n As Integer '
Dim pointObj As AcadPoint '
Dim location(0 To 2) As Double '
Dim meshObj As AcadPolygonMesh '
Dim mSize, nSize, count As Integer '
Dim points(0 To 101) As Double '
L = 20
Xc = 0: Yc = 0
Rc1 = 10
mSize = 2: nSize = 17
n = 0
For t = 0 To 2 * pi + pi / 8 Step pi / 8
points(n) = Rc1 * Cos(t) + Xc: n = n + 1
points(n) = Rc1 * Sin(t) + Yc: n = n + 1
points(n) = 0: n = n + 1
Next t

Rc2 = 0
Xc = 0: Yc = 5
For t = 0 To 2 * pi + pi / 8 Step pi / 8
points(n) = Rc2 * Cos(t) + Xc: n = n + 1
points(n) = Rc2 * Sin(t) + Yc: n = n + 1
points(n) = L: n = n + 1
Next t

Set meshObj = ThisDrawing.ModelSpace.Add3DMesh(mSize, nSize, points)
meshObj.MClose = True
meshObj.NClose = True
ZoomAll
ThisDrawing.Regen acActiveViewport

End Sub

Может есть библиотека подобных процедур? Чтобы не изобретать велеосипед многократно. А нет, так давайте заведем.

[fixo]

Попробуй настоящий конус:

Код:

[Выделить все]

Option Explicit
' draw inclided cone
' written by Fatty T.O.H.(c)2006 * all rights removed

Sub Inc_Cone()

     Dim coneObj As Acad3DSolid
     Dim sliceObj As Acad3DSolid
     Dim rad1 As Double
     Dim rad2 As Double
     Dim cpt(0 To 2) As Double
     Dim rpt1(0 To 2) As Double
     Dim rpt2(0 To 2) As Double
     Dim spt1(0 To 2) As Double
     Dim spt2(0 To 2) As Double
     Dim spt3(0 To 2) As Double
     Dim hgt1 As Double
     Dim hgt2 As Double
     Dim ang As Double
     Dim pi As Double
     
     pi = VBA.Atn(1) * 4
     cpt(0) = 0#: cpt(1) = 0#: cpt(2) = 0#
     rad1 = CDbl(InputBox("Радиус наклонного конуса", "Ввод параметров", "125,254"))
     hgt1 = CDbl(InputBox("Высота наклонного конуса", "Ввод параметров", "598,352"))

     ang = Atn(rad1 * 2 / hgt1) / 2
     rad2 = hgt1 * Sin(ang)
     hgt2 = Sqr(hgt1 ^ 2 - rad2 ^ 2)
     
     Set coneObj = ThisDrawing.ModelSpace.AddCone(cpt, rad2, hgt2)
     rpt1(0) = cpt(0): rpt1(1) = cpt(1): rpt1(2) = cpt(2) + hgt2 / 2
     rpt2(0) = rpt1(0): rpt2(1) = rpt1(1) + 1: rpt2(2) = rpt1(2)
     coneObj.ScaleEntity rpt1, 2
     coneObj.Rotate3D rpt1, rpt2, ang
     spt1(0) = cpt(0): spt1(1) = cpt(1): spt1(2) = cpt(2) - hgt1 / 2 - (hgt1 / 2 - hgt2 / 2)
     spt2(0) = spt1(0): spt2(1) = spt1(1) + 1: spt2(2) = spt1(2)
     spt3(0) = spt1(0) + 1: spt3(1) = spt1(1): spt3(2) = spt1(2)

     Set sliceObj = coneObj.SliceSolid(spt1, spt2, spt3, False)
     Dim NewDirection(0 To 2) As Double
     NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
     ThisDrawing.ActiveViewport.Direction = NewDirection
     ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
     ZoomAll

End Sub

>'J'<