Определение поверхностей твердого тела

[VladimirVladimirovich]

Здравствуйте, уважаемые форумчане!
Есть очень интересная задача: необходимо определить несколько поверхностей твердого тела solid, не имеющего дерева построений.
Исходные данные: есть модель, содержащая только solid, например, болт (или гайка).

Модель болта.PNG (69.31 КБ) Просмотров: 6368

У модели нет ни каких данных о построении, просто твердое тело, но мы точно знаем, что строится она от начала координат в положительных четвертях. Головка болта лежит в нулях, при этом шестигранная часть головки в отрицательных координатах, а цилиндрическая часть болта с резьбовой частью в положительных координатах по "x".
Необходимо:
1. определить самую крайнюю поверхность цилиндрической части - торец болта;
2. определить ближайшую цилиндрическую поверхность от торца болта.
(в случае с гайкой: определить крайнюю плоскую поверхность гайки и внутреннюю цилиндрическую поверхность.)
Искомые поверхности выделены на картинке ниже.

Болт и гайка.png (229.62 КБ) Просмотров: 6368

Задача состоит в автоматизации простановки резьбы на изолированных моделях. Скрипт создает изолированную модель от мастер-модели, а далее в изолированной необходимо проставить резьбу. Хотелось бы уйти от работы совместно с пользователем (как вариант можно на данном этапе вывести приглашение пользователю выбрать поочередно интересующие нас поверхности, после чего скрипт все остальное сделает сам: проставит резьбу какую надо), но к сожалению я не знаю есть ли методы, позволяющие производить анализ геометрии...
Например, можно ли организовать некое сканирование геометрии модели в определенном направлении (ось x), с постоянной проверкой на тип поверхности и наличие геометрии (второе для определения крайней поверхности модели)?

Болт и ось x.png (34.27 КБ) Просмотров: 6368

Или, например, можно ли получить доступ к коллекции всех поверхностей модели, что бы перебирать каждую поверхность и пытаться определить где эта поверхность расположена в пространстве, а там сравнивая координаты попытаться понять, что это за поверхность?

[Artem]

Список поверхностей - самое простое: CATIA.ActiveDocument.Selection.Search "Topology.CGMFace,all" - если нет ограничения на использование селекта, ну а дальше - GetMinimumDistance у measurable тебе в помощь.
воот тут темку почитай:
viewtopic.php?p=19099

[VladimirVladimirovich]

спс!!! Полезненько

[VladimirVladimirovich]

После нескольких дней тестов получилось следующее:
- берем Solid;
- получаем все грани;
- получаем все ребра;
- знаем длину болта и диаметр;
- ищем грань параллельную плоскости YZ (болт вдоль оси X) на расстоянии длины болта;
- нашли грань -> ищем все ребра, принадлежащие данной грани;
- рекурсивно перебираем ребра и ищем цилиндрическую поверхность на расстоянии фаски
- нашли цилиндрическую поверхность -> имеем все, что необходимо для создания резьбы
- создаем резьбу.

Для облегчения чтения данных при debug'е и легкости понимания что есть что сделал два класса: MyEdge и MyFace.
MyEdge - объект ребро

Код: Выделить всё

Option Explicit

Private EdgeNumber As Integer
Private EdgeName As String
Private EdgeReference As Reference
Private EdgeFirstFaceName As String
Private EdgeSecondFaceName As String

Property Let Number(NumberValue As Integer)
    EdgeNumber = NumberValue
End Property

Property Get Number() As Integer
    Number = EdgeNumber
End Property

Property Let Name(NameValue As String)
    EdgeName = NameValue
End Property

Property Get Name() As String
    Name = EdgeName
End Property

Property Let Reference(oReference As Reference)
    Set EdgeReference = oReference
End Property

Property Get Reference() As Reference
    Set Reference = EdgeReference
End Property

'Property Let FirstFaceName(NameValue As String)
'    EdgeFirstFaceName = NameValue
'End Property

Property Get FirstFaceName() As String
    FirstFaceName = EdgeFirstFaceName
End Property

'Property Let SecondFaceName(NameValue As String)
'    EdgeSecondFaceName = NameValue
'End Property

Property Get SecondFaceName() As String
    SecondFaceName = EdgeSecondFaceName
End Property

Public Sub GetFacesFromEdge()
    'Получаем имена граней, которым принадлежит текущее ребро
    Dim TempFirstFaceName As String
    Dim TempSecondFaceName As String
    Dim EdgeNameSplit
    'Выделяем строки с наименованиями граней
    EdgeNameSplit = Split(EdgeName, "Face:")
    'Знаем точно, что у одного ребра может быть только две грани
    'Выделяем названия граней
    TempFirstFaceName = EdgeNameSplit(1)
    TempSecondFaceName = EdgeNameSplit(2)
    'Первая грань ребра
    EdgeFirstFaceName = TempFirstFaceName
    'Вторая грань ребра
    Dim iPos As Integer
    iPos = InStr(TempSecondFaceName, ";None:(Limits")
    If iPos = 0 Then iPos = InStr(TempSecondFaceName, ";AllOrientedIncluded:(Limits")
    TempSecondFaceName = Mid(TempSecondFaceName, 1, iPos)
    EdgeSecondFaceName = TempSecondFaceName
End Sub

MyFace - объект грань

Код: Выделить всё

Option Explicit

Private FaceNumber As Integer
Private FaceName As String
Private FaceReference As Reference

Property Let Number(NumberValue As Integer)
    FaceNumber = NumberValue
End Property

Property Get Number() As Integer
    Number = FaceNumber
End Property

Property Let Name(NameValue As String)
    FaceName = NameValue
End Property

Property Get Name() As String
    Name = FaceName
End Property

Public Sub GetName()
    Dim TempFaceName As String
    Dim TempFaceNameSplit
    'Выделяем имя грани
    TempFaceNameSplit = Split(FaceReference.Name, "Face:")
    TempFaceName = TempFaceNameSplit(UBound(TempFaceNameSplit))
   
    Dim iPos As Integer
    iPos = InStr(TempFaceName, ";Solid")
    TempFaceName = Mid(TempFaceName, 1, iPos)
   
    FaceName = TempFaceName
End Sub

Property Let Reference(oReference As Reference)
    Set FaceReference = oReference
End Property

Property Get Reference() As Reference
    Set Reference = FaceReference
End Property

Property Get TypeOfFace() As String
    TypeOfFace = TypeName(FaceReference)
End Property

Тело модуля - непосредственно поиск поверхностей и создание резьбы

Код: Выделить всё

Private Edges() As MyEdge
Private TempFirstEdges As Collection
Private Faces() As MyFace
Private oSolidElement As Object
Private oPlaneFaceReference As MyFace
Private oCylindricalFaceReference As MyFace
Private StartEdgeNumber As Integer
'Переменные для расчета минимального расстояния от плоскости YZ до граней
Private oSPAWorkbench As Workbench 'Подключение к процессам измерений
Private oMeasurable As Measurable   'Измерения
Private MinimumDistance As Double   'Минимальное расстояние
Private MinDistance As Double

Private d As Integer
Private Pitch As Double
Private ChamferLength As Double
Private DistanceBetweenEdges As Double
Private AngleBetweenFaces As Double

Private oCurrentSelection As Selection

Private Const Pi As Double = 3.14159
Private CylindicalFaceLength As Double

Sub CATMain()

Dim oDocument As INFITF.Document
Dim oPart As Part
Dim oSelection As Selection

Dim PlaneYZRefElement As Reference 'Плоскость YZ для расчета расстояния до граней

Dim L As Double 'Длина болта
L = 5  'мм.
d = 4
Pitch = 0.7
ChamferLength = 0
DistanceBetweenEdges = 0

Set oDocument = CATIA.ActiveDocument
Set oPart = oDocument.Part

Set oSelection = oDocument.Selection
Set oCurrentSelection = oDocument.Selection

oSelection.Clear
oCurrentSelection.Clear

Set PlaneYZRefElement = oPart.OriginElements.PlaneYZ

Set oPlaneFaceReference = Nothing
Set oCylindricalFaceReference = Nothing

Set oSolidElement = Nothing
On Error Resume Next
        Set oSolidElement = oPart.FindObjectByName("Solid.1")
    If (oSolidElement Is Nothing) Then
        ' объект не найден, выходим
        Exit Sub
    End If

oSelection.Add oSolidElement                'Выделяем твердое тело Solid.1
oSelection.Search "Topology.CGMFace,all"    'Поиск всех граней

'Заполняем список граней
ReDim Faces(oSelection.count) As MyFace

For iFace = 1 To oSelection.count
    Set Faces(iFace) = New MyFace
    Faces(iFace).Reference = oSelection.Item(iFace).value
    Faces(iFace).Number = iFace
    Faces(iFace).GetName
Next

'Заполняем список ребер
oSelection.Clear
oSelection.Search "Topology.Edge,all"

ReDim Edges(oSelection.count) As MyEdge

For iEdge = 1 To oSelection.count
    Set Edges(iEdge) = New MyEdge
    Edges(iEdge).Reference = oSelection.Item(iEdge).value
    Edges(iEdge).Name = Edges(iEdge).Reference.Name
    Edges(iEdge).Number = iEdge
    'Определяем грани, прилежащие к текущему ребру
    Edges(iEdge).GetFacesFromEdge
Next

oSelection.Clear

'Производим поиск грани торца (ниаболее удаленная плоская грань от плоскости YZ)
'Подключаемся к измерениям
Set oSPAWorkbench = oDocument.GetWorkbench("SPAWorkbench")

'Перебираем выделенные элементы
For iFace = 1 To UBound(Faces)
    'Получаем грань
    oCurrentSelection.Add Faces(iFace).Reference
    'Получаем измерения для текущей грани
    Set oMeasurable = oSPAWorkbench.GetMeasurable(Faces(iFace).Reference)
    If Faces(iFace).TypeOfFace = "PlanarFace" Then
        'Текущая грань - плоскость/плоская
        'Проверяем параллельность
                AngleBetweenFaces = oMeasurable.GetAngleBetween(PlaneYZRefElement)
                If AngleBetweenFaces <> 0 Then
                    'Данная грань не параллельна YZ - переходи к следующей
                    GoTo NextFace
                End If
        'замеряем расстояние от грани до начала координат по x
        MinimumDistance = oMeasurable.GetMinimumDistance(PlaneYZRefElement)
        MinDistance = CDbl(MinimumDistance)
        MinDistance = Math.Round(MinDistance, 3)
        If MinDistance = L Then
            'найдена грань торца болта
            Set oPlaneFaceReference = Faces(iFace)
            'oPlaneFaceReference.Reference = Faces(iFace).Reference
            'oPlaneFaceReference.Number = Faces(iFace).Number
            'oPlaneFaceReference.Name = Faces(iFace).Name
            MsgBox "Грань найдена"
            GoTo GetEdges
        End If
    End If
NextFace:
    oCurrentSelection.Clear
Next

'Грань не найдена
MsgBox "Грань не найдена."
Exit Sub

GetEdges:

'Поиск ребра/ребер, принадлежащих грани торца
oCurrentSelection.Clear
StartEdgeNumber = 0
'Коллекция ребер, которые могут принадлежать торцевой грани
Set TempFirstEdges = New Collection

For iEdges = 1 To UBound(Edges)
    oCurrentSelection.Add Edges(iEdges).Reference
    If InStr(oPlaneFaceReference.Name, Edges(iEdges).FirstFaceName) > 0 Or _
        InStr(oPlaneFaceReference.Name, Edges(iEdges).SecondFaceName) > 0 Then
        'Найдено ребро
        MsgBox "Ребро от грани торца"
        StartEdgeNumber = Edges(iEdges).Number
        TempFirstEdges.Add Edges(iEdges)
    End If
    oCurrentSelection.Clear
Next

Dim CurrentEdge As MyEdge
For Each CurrentEdge In TempFirstEdges
    FindCylindricalFace CurrentEdge, oPlaneFaceReference
Next

oSelection.Clear

If oCylindricalFaceReference Is Nothing Then
    MsgBox "Не найдена цилиндрическая поверхность"
    Exit Sub
Else
    oSelection.Add oPlaneFaceReference.Reference
    oSelection.Add oCylindricalFaceReference.Reference
End If
MsgBox "Создание резьбы"
oSelection.Clear
'Применение инструмента Thread/Tap - создание резьбы
Dim oThread As Thread
Dim oShapeFactory As ShapeFactory

Set oShapeFactory = oPart.ShapeFactory

Set oThread = oShapeFactory.AddNewThreadWithOutRef

 oThread.LateralFaceElement = oCylindricalFaceReference.Reference
 oThread.LimitFaceElement = oPlaneFaceReference.Reference
 oThread.CreateUserStandardDesignTable "Fastener_Threads", "U:\Fastener_Threads.txt"
 oThread.CreateUserStandardDesignTable "Fastener_Threads", ""
 Dim paramThreadDescription As StrParam
 Set paramThreadDescription = oThread.ThreadDescription
 
 Dim sThreadDescription() As Variant
 ReDim sThreadDescription(paramThreadDescription.GetEnumerateValuesSize - 1)
 'paramThreadDescription.GetEnumerateValues (sThreadDescription)
For iVariantValue = LBound(sThreadDescription) To UBound(sThreadDescription)
    If sThreadDescription(iVariantValue) = "M" + d Then
        paramThreadDescription.value = sThreadDescription(iVariantValue)
        Exit For
    End If
Next
 'oThread.Pitch = Pitch
 'oThread.Diameter = d
 'oThread.Depth = CylindicalFaceLength
 
oPart.UpdateObject oThread

End Sub

Private Sub FindCylindricalFace(CurrentEdge, CurrentFace)

'Для текущего ребра определяем вторую грань
'Dim Edge As MyEdge
'Set Edge = CurrentEdge
'Dim Face As MyFace
'Set Face = CurrentFace

Dim iNFirstPos As Integer
Dim iNSecondPos As Integer
Dim iCFirstPos As Integer
Dim iCSecondPos As Integer
iNFirstPos = 0
iNSecondPos = 0
iCFirstPos = 0
iCSecondPos = 0

If oCylindricalFaceReference Is Nothing Then
    GoTo SearchingFace
Else
    Exit Sub
End If

SearchingFace:

oCurrentSelection.Clear

Dim TempCurrentFaceEdges As Collection

Dim FindNextFaceName As String
Dim NextFace As MyFace

If CurrentFace.Name = CurrentEdge.FirstFaceName Then
    FindNextFaceName = CurrentEdge.SecondFaceName
Else
    FindNextFaceName = CurrentEdge.FirstFaceName
End If

Dim oDistances As Distances
Dim oDistance As Distance

Set oDistances = oSPAWorkbench.Distances

Dim Grad As Double
Grad = 45 * (Pi / 180)

'Поиск второй грани
For iFace = 1 To UBound(Faces)
    Set NextFace = Faces(iFace)
    oCurrentSelection.Add NextFace.Reference
    If NextFace.Name = FindNextFaceName Then
        'Найдена вторая грань
        'определяем тип
        If NextFace.TypeOfFace = "CylindricalFace" Then
            'Найдена цилиндрическая грань
            'Определяем расстояние от ребра до oPlaneFaceReference
            Set oMeasurable = oSPAWorkbench.GetMeasurable(CurrentEdge.Reference)
            MinimumDistance = oMeasurable.GetMinimumDistance(oPlaneFaceReference.Reference)
            MinDistance = CDbl(MinimumDistance)
            MinDistance = Math.Round(MinDistance, 3)
            ChamferLength = Math.Round(((1.227 * Pitch) / 2), 1)
            DistanceBetweenEdges = ChamferLength / Math.Cos(Grad)
            DistanceBetweenEdges = Math.Round(DistanceBetweenEdges, 3)
            If MinDistance >= DistanceBetweenEdges And MinDistance < DistanceBetweenEdges + 0.5 Then
                'Ребро принадлежит искомой цилиндрической поверхности
                Set oCylindricalFaceReference = NextFace
                'Вычисляем длину данной поверхности
                'Расстояние между ребрами данной поверхности
                'Одно ребро известно - текущее
                'Второе ребро - принадлежит данной поверхности
                CylindicalFaceLength = 0
                For iEdge = 1 To UBound(Edges)
                    oCurrentSelection.Clear
                    oCurrentSelection.Add Edges(iEdge).Reference
                    iCFirstPos = InStr(NextFace.Name, Edges(iEdge).FirstFaceName)
                    iCSecondPos = InStr(NextFace.Name, Edges(iEdge).SecondFaceName)
                    If (iCFirstPos > 0) Or (iCSecondPos > 0) Then
                        'Найдено одно из ребер текущей грани
                        If Edges(iEdge).Number <> CurrentEdge.Number Then
                            Set oMeasurable = oSPAWorkbench.GetMeasurable(CurrentEdge.Reference)
                            CylindicalFaceLength = oMeasurable.GetMinimumDistance(Edges(iEdge).Reference)
                            CylindicalFaceLength = CDbl(CylindicalFaceLength)
                            CylindicalFaceLength = Math.Round(CylindicalFaceLength, 3)
                            CylindicalFaceLength = CylindicalFaceLength + ChamferLength
                            Exit For
                        End If
                    End If
                Next
                Exit For
            End If
        Else
        Exit For
        End If
    End If
    oCurrentSelection.Clear
Next


 If oCylindricalFaceReference Is Nothing Then
    'Искомая грань не определена
    'Получаем коллекцию ребер текущей грани
    Set TempCurrentFaceEdges = New Collection
        For iEdges = 1 To UBound(Edges)
        iNFirstPos = InStr(NextFace.Name, Edges(iEdges).FirstFaceName)
        iNSecondPos = InStr(NextFace.Name, Edges(iEdges).SecondFaceName)
        iCFirstPos = InStr(CurrentFace.Name, Edges(iEdges).FirstFaceName)
        iCSecondPos = InStr(CurrentFace.Name, Edges(iEdges).SecondFaceName)
       
        If (iNFirstPos > 0 Or iNSecondPos > 0) And _
            (iCFirstPos = 0 And iCSecondPos = 0) Then
            'Найдено ребро
            TempCurrentFaceEdges.Add Edges(iEdges)
        End If
    Next
 Else
     Exit Sub
 End If
 
 For Each Edge In TempCurrentFaceEdges
    FindCylindricalFace Edge, NextFace
 Next
 
End Sub


В общем прошу сильно не пинать для начала пойдет, а там дальше можно что-либо подправить, дописать усовершенствовать...

P.S.: для создания резьбы использовал текстовый файл со значениями параметров резьбы, который подключал в качестве стандарта, к сожалению Automation не дает доступа к списку значений в параметре типа StrParam, но на VB.Net все работает как часы...

[[PTM]]

кстати в последних релизах резьбу закинули в xml...