개발 요청] 치수 변경, 간섭 체크, 최단 거리 값 구하기 #4

□ Feature Parameter 가져오기 기능 추가

Option Explicit
Option Base 1
Sub FingerCheck01()
    On Error GoTo RunError
    Application.EnableEvents = False

    '// Module Name : CreoVBAStart
    Call CreoVBAStart.CreoConnt01
    
    Dim ModelItemOwner As IpfcModelItemOwner
    Dim modelitems As IpfcModelItems
    Dim BaseDimension As IpfcBaseDimension
    
    Set ModelItemOwner = Model
    Set modelitems = ModelItemOwner.ListItems(EpfcModelItemType.EpfcITEM_DIMENSION)
    
    Dim targetCell As Range
    Dim i, j As Long
    
    '// Parameter Feature
    Dim DistParameterOwner As IpfcParameterOwner
    Dim DistParameter As IpfcParameter
    Dim DistBaseParameter As IpfcBaseParameter
    
    Dim CheckParameterOwner As IpfcParameterOwner
    Dim CheckParameter As IpfcParameter
    Dim CheckBaseParameter As IpfcBaseParameter
    Dim ParamValue As IpfcParamValue
    
     '// SET Regenerate
    Dim Solid As IpfcSolid
    Dim RegenInstructions As New CCpfcRegenInstructions
    Dim Instrs As IpfcRegenInstructions
    Set Instrs = RegenInstructions.Create(False, False, Nothing)
    
             
    For j = 0 To 5 '// Dimension Parameter
           Set targetCell = Range("B5").Offset(0, j + 1)
           
            For i = 0 To modelitems.Count - 1
                Set BaseDimension = modelitems(i)
                
                 If targetCell.value = BaseDimension.Symbol Then
                 
                    Set targetCell = Cells(6, "C").Offset(0, j)
                    BaseDimension.DimValue = targetCell.value
                    
                End If
            Next i
    Next j
    
    '// Regenerate
    Set Solid = Model
    Call Solid.Regenerate(Instrs)
    Call Solid.Regenerate(Instrs)
    
    Set DistParameterOwner = ModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_FEATURE, "MEASURE_DISTANCE_1")
    Set DistParameter = DistParameterOwner.GetParam("DISTANCE")
    
    Set CheckParameterOwner = ModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_FEATURE, "CLEARANCE_1")
    Set CheckParameter = CheckParameterOwner.GetParam("CLEARANCE")
    
    Set DistBaseParameter = DistParameter
    Set CheckBaseParameter = DistParameter
            
    Set ParamValue = DistBaseParameter.value
    Debug.Print ParamValue.DoubleValue
    
    Set ParamValue = DistBaseParameter.value
    Debug.Print ParamValue.DoubleValue
        
    MsgBox "OK"
        
conn.Disconnect (2)
    
    
    '// Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set BaseSession = Nothing
    Set Model = Nothing
    
RunError:
            If Err.Number <> 0 Then
                MsgBox "Process Failed: An error occurred." & vbCrLf & _
                       "Error No: " & CStr(Err.Number) & vbCrLf & _
                       "Error Description: " & Err.Description & vbCrLf & _
                       "Error Source: " & Err.Source, vbCritical, "Error"
                If Not conn Is Nothing Then
                    If conn.IsRunning Then
                        conn.Disconnect (2)
                    End If
                End If
            End If
End Sub

---