사용한 Feature의 수량을 자동 계산 하기

□ Creo 모델에 사용한 Feature의 수량을 표시 하는 프로그램 입니다.

Creo는 매우 다양한 Feature 명령을 제공 합니다. 그러나 대부분의 Feature 타입은 제한된 종류로 사용 됩니다
Creo의  Feature Type과 상태를 표시와 중복된 Feature Type을 카운트 하는 프로그램 입니다.

 

Range ("D2") : 현재의 작업 폴더의 이름을 표시 합니다.
Range ("D3") : 현재의 파일 이름을 표시 합니다.
Range ("D4") : 현재 모델에 사용된 Feature의 총 수량을 표시 합니다.

Range ("B6") :  번호를 표시합니다,
Range ("C6") :  사용자가 입력한 Feature 이름을 표시 합니다.
Range ("D6") :  Feature의 Type 이름을 표시 합니다
Range ("E6") : Feature의 상태를 표시 합니다.

Frature Status : Featue의 상태를 번호로 표시 합니다

 "0" : 일반적인 기능입니다. 대부분 이것에 해당 됩니다
 "1" : 억제되지는 않지만 현재 다른 이유로 사용되지 않는 기능입니다.
 "3" : 단순화 표현 기능에 의해 억제된 피쳐입니다.
 "5" : 억제된 피쳐입니다.
 "6" : 활성 상태이지만 수정되지 않은 재생성 실패로 인해 재생성되지 않는 기능입니다. 
       이 재생성 실패는 이전 피쳐로 인해 발생할 수 있습니다.

 

프로그램 재활용성을 높이기 위해, 프로그램을 여러개의 "모듈"로 만들어, 호출 하도록 하였습니다.

1. CreoVBAStart : 현재 활성화된 모델과 연결 합니다 2. CreoFeatureInfo : "CreoVBAStart"를 호출 합니다.                                   Feature Type을 표시 합니다                                   "DuplicateCount"를 호출 합니다   3. DuplicateCount : 중복 Feature Type을 카우트 합니다 4. CellsDelete : 엑셀의 값을 모두 제거 합니다

 

□ CreoVBAStart

pfcls.CCpfcAsyncConnection.Connect("", "", ".", 5)  : 활성된 모델을 VBA로 불러옵니다

프로시져를 "Public"으로 정의 하였습니다. 다른 모듈에 사용되는 변수는 "Public"으로 선언 해야 합니다.

Option Explicit
Public conn As pfcls.IpfcAsyncConnection
Public model As pfcls.IpfcModel
Public Sub VBAStart()
     
     '// connect creo model
    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim BaseSession As pfcls.IpfcBaseSession
    Dim solid As IpfcSolid
    
    Set conn = asynconn.Connect("", "", ".", 5)
    Set BaseSession = conn.Session
    Set model = BaseSession.CurrentModel
    Set solid = model
     
     '// creo model connection check
     If model Is Nothing Then
        MsgBox "There are No Active Creo Models", vbInformation, "www.idt21c.com"
        Exit Sub
    End If
          
     '// Current Model Information
     Worksheets("Feature Table").Cells(2, "D") = BaseSession.GetCurrentDirectory
     Worksheets("Feature Table").Cells(3, "D") = model.Filename
             
End Sub

□ DuplicateCount

"Feature Table" Sheet에 표시 합니다. 

Range ("A2") : 번호를 표시 합니다.
Range ("B2") : Feature의 Type 이름을 표시 합니다
Range ("D2") : Feature의 Type의 수량을 표시 합니다

Sub Duplicate01()
    
    	Dim rng As Range, C As Range
    	Dim dc As New Collection
    	Set rng = Worksheets("Feature Table").Range("D6", Cells(Rows.Count, "D").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
        Worksheets("Feature Info").Cells(i + 2, "A") = i
        Worksheets("Feature Info").Cells(i + 2, "B") = dc(i)
        Worksheets("Feature Info").Cells(i + 2, "C") = WorksheetFunction.CountIf(rng, CStr(dc(i)))  
    Next i

End Sub

 

□ CreoFeatureInfo / Main 프로그램

Sub FeatureInfo()
  On Error GoTo RunError
  Application.EnableEvents = False

    Call CreoVBAStart.VBAStart

    Dim ModelOwner As IpfcModelItemOwner
    Dim Modelitems As IpfcModelItems
    Dim Modelitem As IpfcModelItem
    Dim Feature As IpfcFeature
    
    Set ModelOwner = model
    Set Modelitems = ModelOwner.ListItems(EpfcModelItemType.EpfcITEM_FEATURE)
    
    Worksheets("Feature Table").Cells(4, "D") = Modelitems.Count
    
    Dim i As Long
    For i = 0 To Modelitems.Count - 1
            Set Modelitem = Modelitems.item(i)
            Set Feature = Modelitem
            
            Worksheets("Feature Table").Cells(i + 6, "B") = i + 1
            Worksheets("Feature Table").Cells(i + 6, "C") = Modelitem.GetName
            Worksheets("Feature Table").Cells(i + 6, "D") = Feature.FeatTypeName
            Worksheets("Feature Table").Cells(i + 6, "E") = Feature.Status
    
    Next i
    Call DuplicateCount.Duplicate01
    MsgBox "정보를 표시하였습니다!", vbInformation, "www.idt21c.com"
    
    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

다른 모듈을 호출 하는 방법은 "모듀 이름. 프로시져 이름"을 문법을 사용 합니다. 

Call CreoVBAStart.VBAStart

□ CellsDelete

엑셀의 모든 값을 삭제 합니다

Sub DeleteRowsBelow()
    
    Worksheets("Feature Table").Range("D2").ClearContents
    Worksheets("Feature Table").Range("D3").ClearContents
    Worksheets("Feature Table").Range("D4").ClearContents
    Worksheets("Feature Table").Rows(6 & ":" & Worksheets("Feature Table").Rows.Count).ClearContents
    Worksheets("Feature Info").Rows(3 & ":" & Worksheets("Feature Info").Rows.Count).ClearContents
    
    MsgBox "Cell을 초기화 하였습니다!", vbInformation, "www.idt21c.com"
    
End Sub

 

TOOLBOX_VBA_FCOUNT.xlsm

0.04MB