Тема: Координаты поверхности
Как програмно получить координату Z с поверхности имея координаты X Y
Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → VBA → Координаты поверхности
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Как програмно получить координату Z с поверхности имея координаты X Y
> mart-soft
Измени координаты X и Y или добавь
интерактивный ввод этих данных:
Option Explicit Function PolyCoords(oEnt As AcadEntity) As Variant ' by Fatty T.O.H. () 2007 * all rights removed ' edited 13/8/08 Dim cnt As Integer Dim i As Integer Dim j As Integer Dim iStep As Integer Dim varPt As Variant Dim dblCoords() As Double Dim dblVert() As Double If TypeOf oEnt Is AcadLWPolyline Then iStep = 2 ElseIf TypeOf oEnt Is Acad3DPolyline Or _ TypeOf oEnt Is AcadPolyline Or _ TypeOf oEnt Is AcadPolyfaceMesh Or _ TypeOf oEnt Is AcadPolygonMesh Then iStep = 3 End If dblCoords = oEnt.Coordinates ReDim ptsArr(0 To (UBound(dblCoords) + 1) \ iStep - 1, 0 To iStep - 1) As Double For i = 0 To (UBound(dblCoords) + 1) \ iStep - 1 For j = 0 To iStep - 1 ptsArr(i, j) = dblCoords(cnt) cnt = cnt + 1 Next Next PolyCoords = ptsArr End Function Sub SearchForZ() Dim e As AcadEntity Dim pt Dim i As Integer Dim found As Boolean ThisDrawing.Utility.GetEntity e, pt, vbCr & "Укажите поверхность" Dim c As Variant c = PolyCoords(e) Dim x As Double Dim y As Double x = -120.346495418606 ' y = 419.364229712635 ' Dim z As Double For i = LBound(c) To UBound(c) If Abs(c(i, 0) - x) <= 0.00001 Then If Abs(c(i, 1) - y) <= 0.00001 Then found = True z = c(i, 2) Exit For End If End If Next If found Then MsgBox "Координата Z = " & z Else MsgBox "Не существует координат с такими X и Y" End If End Sub
~'J'~
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → VBA → Координаты поверхности
Форум работает на PunBB, при поддержке Informer Technologies, Inc