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

□ 프로그램 실행 결과

선택 한 CELL 값들을 조합하여 자동으로 모델을 변경 하고, 측정하는  프로그램입니다.

[ VBA Sheet ]

• 최단 거리 측정 방법은 Creo 모델의 측정 Feature를 만들어, 변경되는 값들을 가져오는 기능 포함 합니다.

[측정 Feature]

• 입력 가능한 조합의 수는 250개("C6:G8")는 문제 없이 동작 하나,  일정 수준의 조합의 수를 넘어가면,
  Creo 모델에서 오류 발생합니다. 아마도 간섭이 발생 하는 값은, 측정 Featured의 값의 세밀하면(0.0000001)
  문제가 발생 하는 것 같습니다. 입력 하는 값이 세밀하고, 간격이 좁으면 측정 Feature에 오류가 발생 합니다.

▷입력 값을 조합하여, 새로운 입력값 개발 

CombinationsUtils.bas

0.00MB

▷Creo 연결 하기

CreoVBAStart.bas

0.00MB

 

▷Main Code

 

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

    '// Module Name : CreoVBAStart
    Call CreoVBAStart.CreoConnt01
    '// Module Name : CombinationsUtils
    Call CombinationsUtils.GenerateAllCombinations
     
    Dim Solid As IpfcSolid
    Set Solid = Model
    
    Dim ModelItemOwner As IpfcModelItemOwner
    Dim modelitem As IpfcModelItem
    Dim BaseDimension As IpfcBaseDimension
    Set ModelItemOwner = Model
    
    Dim targetCell As Range '// Dimension name's (Xdim01 ...)
    Dim i, j As Long
    
    '// Parameter In Feature
    Dim DistParameterOwner As IpfcParameterOwner
    Dim DistParameter As IpfcParameter
    Dim DistBaseParameter As IpfcBaseParameter
    Dim DistParamValue As IpfcParamValue

    Dim CheckParameterOwner As IpfcParameterOwner
    Dim CheckParameter As IpfcParameter
    Dim CheckBaseParameter As IpfcBaseParameter
    Dim CheckParamValue As IpfcParamValue
    
     '// SET Regenerate
    Dim RegenInstructions As New CCpfcRegenInstructions
    Dim Instrs As IpfcRegenInstructions
    Dim Window As pfcls.IpfcWindow
    
    Set Instrs = RegenInstructions.Create(False, False, Nothing)
    Set Window = BaseSession.CurrentWindow

    
    '// Array Dimension
    Dim DimArray(1 To 5) As Variant
    Dim numRows As Long
    Dim numCols As Long
    Dim k1, k2, CellsValue As Long
    
    k2 = 22

    numRows = UBound(resultArray, 1)
    numCols = UBound(resultArray, 2)
                        
                        
    For k1 = 1 To numRows
            For j = 1 To numCols
                    CellsValue = resultArray(k1, j)
                    DimArray(j) = CellsValue
                    Set targetCell = Range("B5").Offset(0, j)
                    Set modelitem = ModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, targetCell)
                    Set BaseDimension = modelitem
                    BaseDimension.DimValue = CellsValue
             Next j
             
              '// Regenerate
              Call Solid.Regenerate(Instrs)
              Window.Repaint

                    Set DistParameterOwner = ModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_FEATURE, "MEASURE_DISTANCE_1")
                    Set DistParameter = DistParameterOwner.GetParam("DISTANCE")
                    Set DistBaseParameter = DistParameter
                    Set DistParamValue = DistBaseParameter.value
                    
                    Set CheckParameterOwner = ModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_FEATURE, "CLEARANCE_1")
                    Set CheckParameter = CheckParameterOwner.GetParam("CLEARANCE")
                    Set CheckBaseParameter = CheckParameter
                    Set CheckParamValue = CheckBaseParameter.value
                    
                                        
                    If CheckParamValue.DoubleValue = 0 Then
                            Worksheets("FingerCheck").Cells(k2, "A") = k2 - 21
                            Worksheets("FingerCheck").Cells(k2, "B") = 0
                            
                            Worksheets("FingerCheck").Cells(k2, "C") = DimArray(1)
                            Worksheets("FingerCheck").Cells(k2, "D") = DimArray(2)
                            Worksheets("FingerCheck").Cells(k2, "E") = DimArray(3)
                            Worksheets("FingerCheck").Cells(k2, "F") = DimArray(4)
                            Worksheets("FingerCheck").Cells(k2, "G") = DimArray(5)
                            
                            Worksheets("FingerCheck").Cells(k2, "H") = Format(DistParamValue.DoubleValue, "0.00")
                            Worksheets("FingerCheck").Cells(k2, "I") = "간섭 없음"
                            k2 = k2 + 1
                            
                            '// Erase DimArray
                    End If

    Next k1

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

 

by korealionkk@gmail.com

---

 

 

 

 

 

---