Code:
'Option Strict On
Option Explicit On
Imports pfclsPublic Class Form1
Private Sub modeleinlesen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles modeleinlesen.Click
Dim items As IpfcModelItems
Dim item As IpfcModelItem
Dim feature As IpfcFeature
Dim i, j As Integer
Dim paramName As String
Dim dimName As String
Dim dimValue As Double
Dim relations As Cstringseq
Dim paramValue As IpfcParamValue
Dim param As IpfcParameter
Dim paramAdded As Boolean
Dim asyncConnection As IpfcAsyncConnection = Nothing
Dim cAC As CCpfcAsyncConnection
Dim session As IpfcBaseSession
' Verbindung zu ProE erstellen
cAC = New CCpfcAsyncConnection()
asyncConnection = cAC.Connect(Nothing, Nothing, Nothing, Nothing)
session = CType(asyncConnection.Session, IpfcBaseSession)
Try
For i = 0 To features.Count - 1
feature = features.Item(i)
'======================================================================
'Get the dimensions in the current feature
'======================================================================
items = feature.ListSubItems(EpfcModelItemType.EpfcITEM_DIMENSION)
If items Is Nothing OrElse items.Count = 0 Then
Continue For
End If
relations = New Cstringseq
'======================================================================
'Loop through all the dimensions and create relations
'======================================================================
For j = 0 To items.Count - 1
item = items.Item(j)
dimName = item.GetName()
paramName = "PARAM_" + dimName
dimValue = CType(item, IpfcBaseDimension).DimValue
param = feature.GetParam(paramName)
paramAdded = False
If param Is Nothing Then
paramValue = (New CMpfcModelItem).CreateDoubleParamValue(dimValue)
feature.CreateParam(paramName, paramValue)
paramAdded = True
Else
If param.Value.discr = EpfcParamValueType.EpfcPARAM_DOUBLE Then
paramValue = (New CMpfcModelItem).CreateDoubleParamValue(dimValue)
CType(param, IpfcBaseParameter).Value = paramValue
paramAdded = True
End If
End If
If paramAdded = True Then
relations.Append(dimName + " = " + paramName)
End If
param = Nothing
Next
CType(feature, IpfcRelationOwner).Relations = relations
Next
Catch ex As Exception
MsgBox(ex.Message.ToString + Chr(13) + ex.StackTrace.ToString)
End Try
End Sub