Creo Feature Type 에서 "CUT (Hole)" Type 표시기

□ Creo 모델에서 특정 Feature Type 을 감추는 기능 개발

Creo 모델에서 "Hole" Feature를 컴색 하여, Feature 이름 및 Feature 번호를 표시 합니다.
해석 프로그램은 Hole 형상이 없어야 합니다. 

• Number
• Feature Name
• Feature Number

Creo 사용자는 Hole Feaure 사용 보다는 Cut Feature를 사용 합니다 Cut Feature는 다음과 같이 표기 됩니다.

• Feature Type : 6
• Feature Name : CUT,  SURFACE TRIM

SURFACE TRIM

 

□ 코드

Feature Type 이름이 "Cut" 이고, Feature가 가지고 있는 치수 Type이 "지름", "반지름" 있는 
Feaure를 체크 하는 코드 입니다

Option Explicit
Sub Feature_hole()
    On Error GoTo RunError
    
    Application.EnableEvents = False
    
    '// Check if "Program11" worksheet exists
    If Not WorksheetExists("Program01") Then
        MsgBox "Worksheet 'Program01' not found.", vbExclamation, "Error"
        Exit Sub
    End If
    
    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection
    
    '// Check Creo Connect
    Set conn = asynconn.Connect("", "", ".", 5)
    
    If conn Is Nothing Then
        MsgBox "An error occurred while starting a new Creo Parametric Session", vbInformation, "www.idt21c.com"
        Exit Sub
    End If

    Dim BaseSession As pfcls.IpfcBaseSession
    Dim model As pfcls.IpfcModel

    Set BaseSession = conn.Session
    Set model = BaseSession.CurrentModel
               
               
    '// Current Model Information
    Worksheets("Program01").Cells(2, "D") = BaseSession.GetCurrentDirectory
    Worksheets("Program01").Cells(3, "D") = model.filename
    
    '// Bring the name of the Feature Type
    
     Dim Modelowner As IpfcModelItemOwner:
     Dim FeatureItems As IpfcModelItems
     Dim Feature As IpfcFeature
    
     Set Modelowner = model
     Set FeatureItems = Modelowner.ListItems(EpfcModelItemType.EpfcITEM_FEATURE)
     
     '// Dimension Type
    
     Dim Dimensionitems As pfcls.IpfcModelItems
     Dim Dimension As pfcls.IpfcBaseDimension
     
     Dim i As Long
     Dim j As Long: j = 0
     Dim k As Long: k = 0
       
     For i = 0 To FeatureItems.Count - 1
          
          Set Feature = FeatureItems(i)
          Set Dimensionitems = Feature.ListSubItems(EpfcModelItemType.EpfcITEM_DIMENSION)
          
          If Feature.FeatType = 6 And Feature.FeatTypeName = "CUT" Then
            
                Cells(j + 6, "B") = j + 1
                Cells(j + 6, "C") = Feature.FeatTypeName
                Cells(j + 6, "D") = Feature.Number
                
                    For k = 0 To Dimensionitems.Count - 1
                    
                        Set Dimension = Dimensionitems(k)
                        
                            If Dimension.DimType = EpfcDIM_DIAMETER Or Dimension.DimType = EpfcDIM_RADIAL Then
                            
                                 Cells(j + 6, "E") = "CIRCLE"
                                 
                            End If
                    
                    Next k
                
                j = j + 1
            
           End If
    
     Next i
    
   MsgBox "완료하였습니다"
    
    
    conn.Disconnect (2)
    
    ' Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set BaseSession = Nothing
    Set model = Nothing
    
Exit Sub

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

Function WorksheetExists(shtName As String) As Boolean
    On Error Resume Next
    WorksheetExists = Not Worksheets(shtName) Is Nothing
    On Error GoTo 0
End Function