선택한 Feature 이름 가져오기

□  Feature 이름 가져오기

모델에서 선택한 Feature의 이름을 가져오는 프로그램 입니다. 사용자가 정의한 Feature의 이름은 표시 할수 있습니다.
하지만 Creo가 자동 생성한 Feature의 이름은 가져올 수 없습니다.

사용자가 정의한 Feature의 이름 사이에는 "공란"을 입력 불가능 합니다. 하지만 Creo가 자동 생성 하는 Feature의 이름에는 "공란"이 존재 합니다.

 

TOOLBOX_VBA001.xlsm

0.03MB

▷ VBA 코드

측정 Feature의 이름을 표시 할수 있습니다.바닦글 (Footer), 그룹에 포함된 Feaure를 선택할 수 있습니다

Option Explicit
Sub Select_Feature_LIST()
    On Error GoTo RunError
    
    Application.EnableEvents = False
    
    '// Check if "Program07" worksheet exists
    If Not WorksheetExists("Program07") Then
        MsgBox "Worksheet 'Program07' not found.", vbExclamation, "Error"
        Exit Sub
    End If
    
    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection
    
    '// Creo Connect Check
    Set conn = asynconn.Connect("", "", ".", 5)
    
    If conn Is Nothing Then
        MsgBox "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("Program07").Cells(2, "E") = BaseSession.GetCurrentDirectory
    Worksheets("Program07").Cells(3, "E") = Model.Filename
    
    Dim Selections As pfcls.IpfcSelections
    Dim SelectionOptions As New pfcls.CCpfcSelectionOptions
    Dim Selopt As pfcls.IpfcSelectionOptions
    Dim FeatureItem As pfcls.IpfcModelItem

    '// Model Feature Select
    Set Selopt = SelectionOptions.Create("feature")
    Selopt.MaxNumSels = 1
    Set Selections = BaseSession.Select(Selopt, Nothing)
       
    Dim rng As Range
    Dim rn As Long
    
    Set rng = Worksheets("Program07").Range("B4", Worksheets("Program07").Cells(Worksheets("Program07").Rows.Count, "B").End(xlUp))
    rn = rng.Rows.Count
    
    If Selections.Count > 0 Then
        Set FeatureItem = Selections.Item(0).SelItem
                
        '// Number 설정
        Worksheets("Program07").Cells(rn + 4, "B") = rn
        '// Feature Name
        Worksheets("Program07").Cells(rn + 4, "D") = FeatureItem.GetName()
        
        If IsEmpty(Cells(rn + 4, "D")) Then
            Worksheets("Program07").Cells(rn + 4, "D") = "기본 Feature"          
        End If
            
    End If
    
    MsgBox "Feature 이름을 표시했습니다", vbInformation, "ToolBOX VBA"
    
    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

Creo가 자동으로 생성한 Feature의 이름은 "기본 Feature"로 표시됩니다.

데이터 베이스에 설계 검증을 하기위한 Feature 이름들이 정의 되어 있고, 모델에 사전 정의된 Feature의 이름을 연계 한다면 자동화된 설계 검증 기능에 활용 할수 있습니다

▷  데이터 베이스 테이블

번호	CODE (Feature Name)	내용	비고
1	HSG-0001	하우징 부품 사이즈	Dimension
2	HSG-0002	하우징 부품 Lock 사이즈	Parameter

 

---

 

영업문의 : lionkk@idt21c.com
카카오 채널 : http://pf.kakao.com/_fItAxb