| Предыдущая тема :: Следующая тема |
| Автор |
Сообщение |
Велиал
Зарегистрирован: 04.05.2012
Сообщения: 20
|
 Добавлено: Чт Мар 14, 2013 5:30 pm Заголовок сообщения: Получение параметров тора |
 |
|
Здравствуйте. Пытаюсь выбрать тор находящийся на модели и получить его параметры (радиус скругления и и угол поворота)ю Пытаюсь получить элемент через ILocateCommandEvents.
| Код: |
Sub Analyze()
CommandState.StartLocate New AnalyzeCommand
End Sub
'class
Implements ILocateCommandEvents
Private Sub ILocateCommandEvents_Accept(ByVal Element As Element, Point As Point3d, ByVal View As View)
Dim area As Double
Dim iXYP As Double
Dim iXZP As Double
Dim iYZP As Double
Dim tol As Double
Dim Centroid As Point3d
Dim Moment As Point3d
Dim PrincipalMoments As Point3d
Dim PrincipalDirections As Point3d
Dim retValue As Long
If Element.Type = msdElementTypeSurface Then
Dim expr As String
expr = "mdlMeasure_surfaceProperties ("
expr = expr & VarPtr(area) & ", "
expr = expr & VarPtr(Centroid) & ", "
expr = expr & VarPtr(Moment) & ", "
expr = expr & VarPtr(iXYP) & ", "
expr = expr & VarPtr(iXZP) & ", "
expr = expr & VarPtr(iYZP) & ", "
expr = expr & VarPtr(PrincipalMoments) & ", "
expr = expr & VarPtr(PrincipalDirections) & ", "
expr = expr & Element.MdlElementDescrP & ", "
expr = expr & "0.01, 0)"
retValue = GetCExpressionValue(expr)
If retValue = 0 Then
Debug.Print "Area: " & area
'Debug.Print "ClosureError: " & closureErrorP
Debug.Print "Centroid: "; Centroid.x; Centroid.y; Centroid.Z
Debug.Print "Second moments: "; Moment.x; Moment.y; Moment.Z
Debug.Print "Inertia(xy): " & iXYP
Debug.Print "Inertia(xz): " & iXZP
Debug.Print "Inertia(yz): " & iYZP
Debug.Print "Principal second moments: "; PrincipalMoments.x; PrincipalMoments.y; PrincipalMoments.Z
Debug.Print "Principal axes: "; PrincipalDirections.x; PrincipalDirections.y; PrincipalDirections.Z
Else
Debug.Print "Returned error: " & retValue
End If
End If
End Sub
Private Sub ILocateCommandEvents_Cleanup()
End Sub
Private Sub ILocateCommandEvents_Dynamics(Point As Point3d, ByVal View As View, ByVal DrawMode As MsdDrawingMode)
End Sub
Private Sub ILocateCommandEvents_LocateFailed()
ShowStatus "No arc element found"
End Sub
Private Sub ILocateCommandEvents_LocateFilter(ByVal Element As Element, Point As Point3d, Accepted As Boolean)
Accepted = False
If Element.Type = msdElementTypeSurface Then
Accepted = True
End If
End Sub
Private Sub ILocateCommandEvents_LocateReset()
End Sub
Private Sub ILocateCommandEvents_Start()
Dim lc As LocateCriteria
Set lc = CommandState.CreateLocateCriteria(False)
CommandState.SetLocateCriteria lc
End Sub
|
Получаю Данные параметры. Из полезного пока только centroid. Как теперь узнать, угол поворота тора и его радиус? |
|
| Вернуться к началу |
|
 |
Велиал
Зарегистрирован: 04.05.2012
Сообщения: 20
|
| Добавлено: Вс Мар 17, 2013 5:58 pm Заголовок сообщения: |
|
|
| Тогда вопрос такой. Тор (поверхность) Состоит из 4 -х дуг и 2 эллипсов. Как можно получить к ним доступ, что бы считать их расположение, угол поворота и вектора? |
|
| Вернуться к началу |
|
|
Leonid
давно здесь сидим
Зарегистрирован: 28.01.2006
Сообщения: 598
Откуда: С.-Петербург
|
| Добавлено: Пн Мар 18, 2013 4:16 pm Заголовок сообщения: |
|
|
может эту функцию попробовать?
| Код: | int mdlSurface_extractRevolution2
(
MSElementDescr** boundaryEdPP ,
DPoint3d* centerP ,
DPoint3d* axisP ,
double* sweepAngleP ,
MSElementDescr* surfaceEdP
);
|
|
|
| Вернуться к началу |
|
|
Leonid
давно здесь сидим
Зарегистрирован: 28.01.2006
Сообщения: 598
Откуда: С.-Петербург
|
| Добавлено: Вт Мар 19, 2013 8:12 am Заголовок сообщения: |
|
|
Вроде вот так работает
| Код: |
Public Declare Function mdlSurface_revolutionIsTorus Lib "stdmdlbltin.dll" (ByRef primaryRadiusP As Double, ByRef secondaryRadiusP As Double, ByRef centerP As Point3d, ByRef rotMatrixP As Matrix3d, ByVal boundaryEdP As Long, ByRef revCenterP As Point3d, ByRef revAxisP As Point3d, ByVal revSweep As Double) As Long
Public Declare Function mdlSurface_extractRevolution2 Lib "stdmdlbltin.dll" (ByRef boundaryEdPP As Long, ByRef centerP As Point3d, ByRef axisP As Point3d, ByRef sweepAngleP As Double, ByVal surfaceEdP As Long) As Long
Sub AnalyzeArc()
CommandState.StartLocate New AnalyzeCommand
End Sub
|
| Код: |
Private Sub ILocateCommandEvents_Accept(ByVal Element As Element, Point As Point3d, ByVal View As View)
Dim p1 As Point3d
Dim pCentRev As Point3d
Dim pCentTor As Point3d
Dim pAxis As Point3d
Dim dPrimRad As Double
Dim dSecRad As Double
Dim mRotation As Matrix3d
Dim dSweepAngleRadians As Double
Dim edpBond As Long
Call mdlSurface_extractRevolution2(edpBond, pCentRev, pAxis, dSweepAngleRadians, Element.MdlElementDescrP)
Call mdlSurface_revolutionIsTorus(dPrimRad, dSecRad, pCentTor, mRotation, edpBond, pCentRev, pAxis, dSweepAngleRadians)
End Sub
|
|
|
| Вернуться к началу |
|
|
Велиал
Зарегистрирован: 04.05.2012
Сообщения: 20
|
| Добавлено: Вт Мар 19, 2013 5:28 pm Заголовок сообщения: |
|
|
Спасибо огромное за ответы. Пытаюсь применить полученные данные для создания дуги. Но есть вопрос по параметрам
| Код: |
' pCentRev 'центр тора полученный mdlSurface_extractRevolution2
' dPrimRad первичный радиус полученный из mdlSurface_revolutionIsTorus
' mRotation Матрица полученная из mdlSurface_extractRevolution2
' dSweepAngleRadians угол поворота полученный из mdlSurface_revolutionIsTorus
Dim iArc As ArcElement
Set iArc = CreateArcElement2(Nothing, pCentRev, dPrimRad, dPrimRad, mRotation, Radians(0)' начальный угол и где его взять?угол , dSweepAngleRadians)
ActiveModelReference.AddElement iArc
iArc.Redraw msdDrawingModeNormal
|
Дуга строиться, но не в той плоскости что и тор, а перпендикулярно ему из начала тора. как с этим бороться? Заранее спасибо |
|
| Вернуться к началу |
|
|
Leonid
давно здесь сидим
Зарегистрирован: 28.01.2006
Сообщения: 598
Откуда: С.-Петербург
|
| Добавлено: Ср Мар 20, 2013 12:58 pm Заголовок сообщения: |
|
|
| Велиал писал(а): |
Дуга строиться, но не в той плоскости что и тор, а перпендикулярно ему из начала тора. как с этим бороться? Заранее спасибо |
параметр mRotation - матрица поворота, которая определяет положение элемента в пространстве. Если получается перпендикулярно, то нужно ее повернуть на 90° |
|
| Вернуться к началу |
|
|
Велиал
Зарегистрирован: 04.05.2012
Сообщения: 20
|
| Добавлено: Ср Мар 20, 2013 1:53 pm Заголовок сообщения: |
|
|
Спасибо. Это это понятно. Я сделал свою матрицу
| Код: |
' pAxis - ось вращения взятая из тела вращения
Call mdlRMatrix_fromNormalVector(myRot, pAxis)
|
В принципе работает. Теперь надо как то узнать начальный угол. |
|
| Вернуться к началу |
|
|
Leonid
давно здесь сидим
Зарегистрирован: 28.01.2006
Сообщения: 598
Откуда: С.-Петербург
|
| Добавлено: Ср Мар 20, 2013 3:37 pm Заголовок сообщения: |
|
|
| если у тора начальный угол равен нулю, то для дуги надо или вычислять этот угол или поворачивать дугу по матрице отн. оси Z |
|
| Вернуться к началу |
|
|
Велиал
Зарегистрирован: 04.05.2012
Сообщения: 20
|
| Добавлено: Ср Июн 05, 2013 4:13 pm Заголовок сообщения: |
|
|
Сорри, долго не было. В общем никак не получается. Пытался найти и начальный угол и поворачивать матрицу и дугу. Но все как то не так, корежит...
В общем код приведен выше, но получается вот такая фигня
Уже голову себе сломал, не понимаю почему именно так происходит? Мне казалось, что матрица извлеченная из тора должна показывать его ориентацию в пространстве и если вставить ее при построении дуги, то она должна так же в пространстве располагаться.
В общем прошу помощи, а то обидно, почти все закончил, а вот об эту вещь споткнулся(( |
|
| Вернуться к началу |
|
|
Leonid
давно здесь сидим
Зарегистрирован: 28.01.2006
Сообщения: 598
Откуда: С.-Петербург
|
| Добавлено: Чт Июн 06, 2013 7:25 am Заголовок сообщения: |
|
|
На первый взгляд похоже, что надо инвертировать полученную матрицу.
Чтобы проще было помочь, выложите модуль с кодом, в котором проблема |
|
| Вернуться к началу |
|
|
Велиал
Зарегистрирован: 04.05.2012
Сообщения: 20
|
| Добавлено: Чт Июн 06, 2013 12:55 pm Заголовок сообщения: |
|
|
Class Module
| Код: |
Option Explicit
Private Declare Function mdlSurface_revolutionIsTorus Lib "stdmdlbltin.dll" (ByRef primaryRadiusP As Double, ByRef secondaryRadiusP As Double, ByRef centerP As Point3d, ByRef rotMatrixP As Matrix3d, ByVal boundaryEdP As Long, ByRef revCenterP As Point3d, ByRef revAxisP As Point3d, ByVal revSweep As Double) As Long
Private Declare Function mdlSurface_extractRevolution2 Lib "stdmdlbltin.dll" (ByRef boundaryEdPP As Long, ByRef centerP As Point3d, ByRef axisP As Point3d, ByRef sweepAngleP As Double, ByVal surfaceEdP As Long) As Long
Implements ILocateCommandEvents
Private Sub ILocateCommandEvents_Accept(ByVal Element As Element, point As Point3d, ByVal view As view)
If Element.Type = msdElementTypeSurface Or Element.Type = msdElementTypeSolid Then
Dim iarc As ArcElement
Dim pCentRev As Point3d
Dim pCentTor As Point3d
Dim pAxis As Point3d
Dim dPrimRad As Double
Dim dSecRad As Double
Dim mRotation As Matrix3d
Dim dSweepAngleRadians As Double
Dim edpBond As Long
Call mdlSurface_extractRevolution2(edpBond, pCentRev, pAxis, dSweepAngleRadians, Element.MdlElementDescrP)
Call mdlSurface_revolutionIsTorus(dPrimRad, dSecRad, pCentTor, mRotation, edpBond, pCentRev, pAxis, dSweepAngleRadians)
Set iarc = CreateArcElement2(Nothing, pCentRev, dPrimRad, dPrimRad, mRotation, Radians(0), dSweepAngleRadians)
ActiveModelReference.AddElement iarc
iarc.Redraw msdDrawingModeNormal
End If
End Sub
Private Sub ILocateCommandEvents_Cleanup()
End Sub
Private Sub ILocateCommandEvents_Dynamics(point As Point3d, ByVal view As view, _
ByVal DrawMode As MsdDrawingMode)
End Sub
Private Sub ILocateCommandEvents_LocateFailed()
ShowStatus "No arc element found"
End Sub
Private Sub ILocateCommandEvents_LocateFilter(ByVal Element As Element, point As Point3d, Accepted As Boolean)
Accepted = True
ShowPrompt "True" & Element.Type
End Sub
Private Sub ILocateCommandEvents_LocateReset()
End Sub
Private Sub ILocateCommandEvents_Start()
Dim lc As LocateCriteria
Set lc = CommandState.CreateLocateCriteria(False)
CommandState.SetLocateCriteria lc
ShowCommand "Analyze Arc Example"
ShowPrompt "Select an arc"
End Sub
|
Module
| Код: |
Sub SolidGetVolProps()
CommandState.StartLocate New SolidGetVolumeProps
End Sub
|
|
|
| Вернуться к началу |
|
|
Leonid
давно здесь сидим
Зарегистрирован: 28.01.2006
Сообщения: 598
Откуда: С.-Петербург
|
| Добавлено: Чт Июн 06, 2013 4:09 pm Заголовок сообщения: |
|
|
Я тоже не совсем понял - зачем он ось тора поворачивает, не стал искать причину, а тупо исправил матрицу поворотом на 90 градусов... вроде работает
| Код: |
Private Sub ILocateCommandEvents_Accept(ByVal Element As Element, point As Point3d, ByVal view As view)
If Element.Type = msdElementTypeSurface Or Element.Type = msdElementTypeSolid Then
Dim iarc As ArcElement
Dim pCentRev As Point3d
Dim pCentTor As Point3d
Dim pAxis As Point3d
Dim dPrimRad As Double
Dim dSecRad As Double
Dim mRotation As Matrix3d
Dim dSweepAngleRadians As Double
Dim edpBond As Long
Call mdlSurface_extractRevolution2(edpBond, pCentRev, pAxis, dSweepAngleRadians, Element.MdlElementDescrP)
Call mdlSurface_revolutionIsTorus(dPrimRad, dSecRad, pCentTor, mRotation, edpBond, pCentRev, pAxis, dSweepAngleRadians)
Dim rm As Matrix3d
rm = Matrix3dFromAxisAndRotationAngle(0, Radians(-90))
mRotation = Matrix3dFromMatrix3dTimesMatrix3d(mRotation, rm)
Set iarc = CreateArcElement2(Nothing, pCentRev, dPrimRad, dPrimRad, mRotation, Radians(0), dSweepAngleRadians)
ActiveModelReference.AddElement iarc
iarc.Redraw msdDrawingModeNormal
End If
End Sub
|
|
|
| Вернуться к началу |
|
|
Велиал
Зарегистрирован: 04.05.2012
Сообщения: 20
|
| Добавлено: Ср Июн 12, 2013 9:19 pm Заголовок сообщения: |
|
|
Спасибо большое. Поворачивать он поворачивает, но тут появилась другая проблема - он поворачивает в разные стороны:
А вот что на это влияет не понятно. Лечится это изменением значения поворота с -90 на 90 Код:
| Код: | | rm = Matrix3dFromAxisAndRotationAngle(0, Radians(-90)) |
Причем как бы я не рисовал торы, программа все рисует правильно, а если открываю чужую, ранее нарисованную, модель, то проявляется вот такое вот безобразие.
Пример |
|
| Вернуться к началу |
|
|
Leonid
давно здесь сидим
Зарегистрирован: 28.01.2006
Сообщения: 598
Откуда: С.-Петербург
|
| Добавлено: Чт Июн 13, 2013 10:28 am Заголовок сообщения: |
|
|
Да, действительно, можно мозг сломать 
Вот здесь похоже и проходит граница возможностей VBA...
Из очередных попыток танцев с бубнами я бы предложил проверять полученню дугу по Range. Если она выпадает за Range тора, то вертеть ее в другую сторону |
|
| Вернуться к началу |
|
|
Велиал
Зарегистрирован: 04.05.2012
Сообщения: 20
|
| Добавлено: Сб Июн 15, 2013 2:07 pm Заголовок сообщения: |
|
|
Спасибо за идею. Пока сделал так:
| Код: |
Dim oRan As Range3d
Dim l As LineElement
Dim mas() As Point3d
Dim i As Integer
oRan = Element.range
'Рисуем линию от верхней до нижней границы диапазона
Set l = CreateLineElement2(Nothing, oRan.High, oRan.Low)
' Ищем точки пересечения нарисованной дуги с нарисованной линией линией
mas = l.GetIntersectionPoints(iarc, iarc.Rotation)
For i = LBound(mas) To UBound(mas)
Debug.Print "mas: " & mas(i).x & " " & mas(i).y & " " & mas(i).Z
Next
' Если i=0 то меняем знак и перерисовываем дугу, если больше 0, то рисуем исходную дугу
|
Но есть такое ощущение, что все не так просто и где-нибудь я еще наткнусь на проблему  |
|
| Вернуться к началу |
|
|
|
|
Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете голосовать в опросах
|
Powered by phpBB © 2001, 2005 phpBB Group
|
FAQ
Поиск
Пользователи
Группы
Регистрация
Профиль
Войти и проверить личные сообщения
Вход
