업무 자동화/VBA, VB.NET For Creo

Creo Feature Type 가져오기

ToolBOX01 2024. 3. 23. 13:59

□ Feature Type을 표시 하는 방법

Creo 모델은 다양한 Feature로 구성 되어 있습니다  다음과 같이 가져올 수 있습니다.

  • Part

  • Assemble

 

□ 코드

Option Explicit
Sub Feature_name()
    On Error GoTo RunError
    
    Application.EnableEvents = False
    
    '// Check if "Program12" worksheet exists
    If Not WorksheetExists("Program02") Then
        MsgBox "Worksheet 'Program02' 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("Program02").Cells(2, "D") = BaseSession.GetCurrentDirectory
    Worksheets("Program02").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)
     
     Dim i As Long
       
     For i = 0 To FeatureItems.Count - 1
          
          Set Feature = FeatureItems(i)
            
          Cells(i + 6, "B") = i + 1
          Cells(i + 6, "C") = Feature.FeatTypeName
          Cells(i + 6, "D") = Feature.Number
          Cells(i + 6, "E") = Feature.FeatType

     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

 

위 코드는 다양 하게 응용 하여, 사용 가능 합니다

Feature Type Name Feature Type Number 비고
EXTERNAL INHERITANCE 240  
GROUP HEAD 181  
REFERENCE FEATURE 200 Reference Type : 
Intent Datum Coordinate System
EXTERN COPY GEOM 167  
ANNOTATION FEATURE 235  
CHAMFER 4  
OFFSET 31  
DRAFT 17  
ROUND 3  
SURFACE 32 Boundary  Blend
PATCH 71 Solidify
SHELL 18  
PATTERN 233  
CURVE 39  
MIRROR 181  
SURFACE TRIM 6  
COORDINATE SYSTEM 68  
HOLE 1  

 


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