Список форумов Конференция САПР Bentley MicroStation Конференция САПР Bentley MicroStation
www.ustation.ru
 
 FAQFAQ   ПоискПоиск   ПользователиПользователи   ГруппыГруппы   РегистрацияРегистрация 
 ПрофильПрофиль   Войти и проверить личные сообщенияВойти и проверить личные сообщения   ВходВход 

Получение параметров тора

 
Начать новую тему   Ответить на тему    Список форумов Конференция САПР Bentley MicroStation -> Прикладное
Предыдущая тема :: Следующая тема  
Автор Сообщение
Велиал



Зарегистрирован: 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 
);
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
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
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
Велиал



Зарегистрирован: 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°
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
Велиал



Зарегистрирован: 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
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
Велиал



Зарегистрирован: 04.05.2012
Сообщения: 20

СообщениеДобавлено: Ср Июн 05, 2013 4:13 pm    Заголовок сообщения: Ответить с цитатой

Сорри, долго не было. В общем никак не получается. Пытался найти и начальный угол и поворачивать матрицу и дугу. Но все как то не так, корежит...
Sad
В общем код приведен выше, но получается вот такая фигня


Уже голову себе сломал, не понимаю почему именно так происходит? Мне казалось, что матрица извлеченная из тора должна показывать его ориентацию в пространстве и если вставить ее при построении дуги, то она должна так же в пространстве располагаться.
В общем прошу помощи, а то обидно, почти все закончил, а вот об эту вещь споткнулся((
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
Leonid
давно здесь сидим


Зарегистрирован: 28.01.2006
Сообщения: 598
Откуда: С.-Петербург

СообщениеДобавлено: Чт Июн 06, 2013 7:25 am    Заголовок сообщения: Ответить с цитатой

На первый взгляд похоже, что надо инвертировать полученную матрицу.

Чтобы проще было помочь, выложите модуль с кодом, в котором проблема
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
Велиал



Зарегистрирован: 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


Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
Велиал



Зарегистрирован: 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    Заголовок сообщения: Ответить с цитатой

Да, действительно, можно мозг сломать Smile
Вот здесь похоже и проходит граница возможностей VBA...

Из очередных попыток танцев с бубнами я бы предложил проверять полученню дугу по Range. Если она выпадает за Range тора, то вертеть ее в другую сторону
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
Велиал



Зарегистрирован: 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, то рисуем исходную дугу

Но есть такое ощущение, что все не так просто и где-нибудь я еще наткнусь на проблему Very Happy
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
Показать сообщения:   
Начать новую тему   Ответить на тему    Список форумов Конференция САПР Bentley MicroStation -> Прикладное Часовой пояс: GMT + 3
Страница 1 из 1

 
Перейти:  
Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете голосовать в опросах


Powered by phpBB © 2001, 2005 phpBB Group