모델의 Feature 정보를 알아보는 프로그램 Ver 0.1

모델을 구성 하는 Feature의 이름, 타입, ID, 상태를 리스트로 만들수 있습니다. Feature의 상태는 Supress 상태 (번호 5로 표시 됩니다)인지, 아닌지를 알 수 있습니다.  Supress 상태 Creo로 부터 Feature 번호를 부여받지 못합니다. insert 모드이면 하위 Feature들은 Supress 상태 입니다. Feature가 오류가 있으면 Feature의 상태 번호는 변경 됩니다.

 

[ 모델의 Feature 분석]

 

 

 

새로 고침을 클릭하면 자동으로 Feature 이름을 가져 옵니다. 일부 Feature의 경우 Creo가 자동으로 부여하는 이름을 가져 오지 않습니다. Supress 된 Feature는 Feature Count에서 제외 됩니다. Feature Status에서는 "5"로 표시 됩니다.

 

Sub Feature_LIST2()

     On Error GoTo RunError
     
        Dim asynconn As New pfcls.CCpfcAsyncConnection
        Dim conn As pfcls.IpfcAsyncConnection: Set conn = asynconn.Connect("", "", ".", 5)
        Dim oSession As pfcls.IpfcBaseSession: Set oSession = conn.session
        Dim oModel As IpfcModel: Set oModel = oSession.CurrentModel
        
        'Model File location
        Cells(2, "C") = oSession.GetCurrentDirectory
        
        'Model File Name
        Cells(1, "C") = oModel.Filename
               
                
        'Feature LIST
        Dim oModelowner As IpfcModelItemOwner: Set oModelowner = oModel
        Dim oModelItems As IpfcModelItems
            Set oModelItems = oModelowner.ListItems(EpfcModelItemType.EpfcITEM_FEATURE)
        Dim oModelitem As IpfcModelItem
        Dim oFeature As IpfcFeature
        
        Dim i As Long
        Dim k As Long: k = 0

                   
        'Excel Display
        For i = 0 To oModelItems.Count - 1
                  Set oModelitem = oModelItems(i)
                  Set oFeature = oModelitem
                  oFeatureStatus = oFeature.Status
                                
                  If oFeature.FeatType <> 13 Or oFeature.Number <> "" Then
                        Cells(k + 6, "A") = k + 1
                        Cells(k + 6, "B") = oModelitem.GetName
                        Cells(k + 6, "C") = oFeature.FeatTypeName
                        Cells(k + 6, "D") = oFeature.Number
                        Cells(k + 6, "E") = oFeatureStatus
                        
                        k = k + 1
                 End If

        Next i
        
        Cells(3, "C") = k


        Dim rng As Range
        Set rng = Range("E6", Cells(Rows.Count, "E").End(xlUp))
        
        Dim j As Long, m As Long
        Dim oSupressCount As Long: oSupressCount = 0
                
            For j = 0 To rng.Count - 1
                m = Cells(j + 6, "E")
                
                If m = 5 Then
                   oSupressCount = oSupressCount + 1
                End If
                
            Next j
             
         Cells(4, "C") = oSupressCount



     
    conn.Disconnect (2)
    
    'Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set session = Nothing
    Set model = Nothing
    

RunError:

    If Err.Number <> 0 Then
        MsgBox "Process Failed : Unknown error occurred." + Chr(13) + _
                "Error No: " + CStr(Err.Number) + Chr(13) + _
                "Error: " + Err.Description, vbCritical, "Error"

        If Not conn Is Nothing Then
            If conn.IsRunning Then
                conn.Disconnect (2)
            End If
        End If
    End If
End Sub

Sub modelinitialzation()

            'Cells clear
            Cells(1, "C").Select: Selection.ClearContents
            Cells(2, "C").Select: Selection.ClearContents
            Cells(3, "C").Select: Selection.ClearContents
            Cells(4, "C").Select: Selection.ClearContents
          
            Range(Cells(6, "A"), Cells(Rows.Count, "A")).EntireRow.Delete
          

End Sub

Sub Duplicate_01()
    
    Dim rng As Range, C As Range
    Dim dc As New Collection
    Set rng = Range("C6", Cells(Rows.Count, "C").End(xlUp))

On Error Resume Next

    For Each C In rng
        If Len(C) Then
            dc.Add Trim(C), CStr(Trim(C))
        End If
    Next
    
On Error GoTo 0

    For i = 1 To dc.Count
        Cells(i + 6, "Y") = dc(i) 'File Name
    Next

    For i = 1 To dc.Count
        Cells(i + 6, "Z") = WorksheetFunction.CountIf(rng, dc(i)) ' 중복 수량 카운트
        'Cells(i + 6, "A") = i + 1 'Number Count
    Next

'Columns("Z").Delete
'Columns("W").Delete
End Sub

 

feature name List V3.xlsm

0.03MB

 

 

by lionkk@idt21c.com