Dim oApp As Inventor.Application
Dim oDoc As Inventor.Document
Dim oPartDoc As Inventor.PartDocument '.Document
Dim oCompDef As PartComponentDefinition
Dim invVBA As InventorVBAMember
Dim oParameters As Parameters
Dim oClassMaterial As Parameter
'Dim ClassMaterial As String = ""
Dim oMaterial As Material
Dim oNewMaterial As Material
'Dim oMaterials As Materials
Dim x1 As Double = 0 'плотность
Dim x2 As Double = 0 'линейное расширение 10^-5 1/с
Dim x3 As Double = 0 'удельная теплоемкость Дж / [кг*К]
Dim x4 As Double = 0 'теплопроводность Вт/[м*K]
Dim x5 As Double = 0 'Прочность На Растяжение МРа
Dim x6 As Double = 0 'предел текучести МРа
Dim x7 As Double = 0 'Модуль Юнга ГРа
Dim x8 As Double = 0 'Модуль сдвига
Dim x9 As Double = 0 'коэфициент Пуансона (безразмерный)
' Установка ссылки на документ детали
' Предполагается, что документ детали активен.
oApp = GetObject(, "Inventor.Application")
oDoc = oApp.ActiveDocument
If oDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
oPartDoc = oApp.ActiveDocument
'MsgBox("из детали")
Else oPartDoc = oApp.ActiveEditObject
'MsgBox("из сборки")
End If
oCompDef = oPartDoc.ComponentDefinition
' Получение преобразованных значений из ListBox3
For i = 0 To ListBox3.Rows.Count - 1
'MsgBox(ListBox3.Item(0, I).Value & "=" & ListBox3.Item(1, I).Value)
Try
Select Case ListBox3.Item(4, i).Value
Case 731
x1 = parametr() / 1000 'плотность
'MsgBox("плотность=" & x1)
Case 733
x2 = parametr() 'линейное расширение 10^-5 1/C
' MsgBox("линейное расширение=" & x2)
Case 582749
x3 = parametr() 'удельная теплоемкость Дж / [кг*К]
' MsgBox("удельная теплоемкость=" & x3)
Case 582747
x4 = parametr() 'теплопроводность Вт/[м*K]
'MsgBox("теплопроводность=" & x4)
Case 738
x5 = parametr() / (10 ^ 6) 'Прочность На Растяжение МРа
'MsgBox("Прочность На Растяжение=" & x5)
Case 739
x6 = parametr() / (10 ^ 6) 'предел текучести МРа
'MsgBox("предел текучести=" & x6)
Case 728
x7 = parametr() / (10 ^ 9) 'Модуль Юнга ГРа
'MsgBox("Модуль Юнга =" & x7)
Case 730
x8 = parametr() / (10 ^ 9)
'MsgBox("Модуль сдвига =" & x8)
End Select
Catch
MsgBox("Не читаемые свойства материала")
Exit Sub
End Try
Next
If x7 <> 0 And x8 <> 0 Then
x9 = (x7 / (2 * x8)) - 1 'коэфициент Пуансона (безразмерный)
End If
Try
' Зачистка колекции материалов перед созданием нового
oMaterial = oPartDoc.Materials.Item("Типовые")
oCompDef.Material = oMaterial
For i3 = 1 To oPartDoc.MaterialAssets.Count
If oPartDoc.MaterialAssets.Item(i3).DisplayName = oCompDef.Material.Name Then
If oPartDoc.MaterialAssets.Count = 1 Then
Exit For
End If
Else
oPartDoc.MaterialAssets.Item(i3).Delete()
i3 = i3 - 1
End If
Next
' Создание нового материала.
oNewMaterial = oPartDoc.Materials.Add(ListBox2.SelectedCells.Item(0).Value, x1)
Catch
MsgBox("При создании материала произошла ошибка, возможно в базе Ascon отсутствует значение плотности или деталь сохранена не в активном проекте.")
FormAscon.ActiveForm.Close()
Exit Sub
End Try
' Определите другие свойства материала
'Произвольно назначает первый стиль визуализации в коллекции стилей визуализации.
oNewMaterial.RenderStyle = oPartDoc.RenderStyles.Item("По умолчанию")
'линейное расширение 10^5м/м/с
oNewMaterial.LinearExpansion = x2
'удельная теплоемкость Дж / [кг*К]
oNewMaterial.SpecificHeat = x3
'теплопроводность Вт/[м*K]
oNewMaterial.ThermalConductivity = x4
'Прочность На Растяжение МРа
oNewMaterial.UltimateTensileStrength = x5
'предел текучести МРа
oNewMaterial.YieldStrength = x6
'Модуль Юнга ГРа
oNewMaterial.YoungsModulus = x7
'Модуль Сдвига мРа
'oNewMaterial.????? = x8
'коэфициент Пуансона (безразмерный)
oNewMaterial.PoissonsRatio = x9
'присвоение созданного материала активной детали
oCompDef.Material = oNewMaterial
