VBA : 서피스 선택하기

□ 소개

모델에서 한개의 서피스를 선택 하고, 선택된 서피스의 면적을 구하는 기능 입니다.

[ 서피스 선택 ]

 

□코드

Option Explicit
Sub selectsurface()
    On Error GoTo RunError
    
    Application.EnableEvents = False
    
    '// Check if "Program03" worksheet exists
    If Not WorksheetExists("Program03") Then
        MsgBox "Worksheet 'Program03' 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 Session As IpfcSession
    Dim model As pfcls.IpfcModel
    Dim Solid As IpfcSolid
    
    '// Current Model Information
    Set BaseSession = conn.Session
    Set model = BaseSession.CurrentModel
    Set Solid = model
    
    Worksheets("Program03").Cells(2, "D") = BaseSession.GetCurrentDirectory
    Worksheets("Program03").Cells(3, "D") = model.filename
    
    Dim SelectionOptions As New pfcls.CCpfcSelectionOptions
    Dim Selopt As pfcls.IpfcSelectionOptions
    Dim Selections As pfcls.IpfcSelections
    Dim Selection As IpfcSelection
    Dim ModelItem As IpfcModelItem
    Dim Surface As IpfcSurface
    
    Set Selopt = SelectionOptions.Create("surface")
    Selopt.MaxNumSels = 1
    Set Selections = BaseSession.Select(Selopt, Nothing)
    
    Set Selection = Selections.item(0)
    Set ModelItem = Selection.SelItem
    Set Surface = ModelItem
    
    MsgBox Surface.EvalArea

    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

 

Dim SelectionOptions As New pfcls.CCpfcSelectionOptions
Dim Selopt As pfcls.IpfcSelectionOptions
Dim Selections As pfcls.IpfcSelections

  
 Set Selopt = SelectionOptions.Create("surface")
 Selopt.MaxNumSels = 1
 Set Selections = BaseSession.Select(Selopt, Nothing)

마우스로 모델의 요소를 선택 하는것 입니다. "surface"로 고정 하였습니다.
선택 하는 개수는 "1"로 고정 하였습니다
 Set Selections = ~ 은 Creo 모델을 마우스로 선택을 실행 합니다.

 

□ 두개의 서피스를 선택 하고, 면적을 표시 하는 코드

Option Explicit
Sub selectsurface()
    On Error GoTo RunError
    
    Application.EnableEvents = False
    
    '// Check if "Program03" worksheet exists
    If Not WorksheetExists("Program03") Then
        MsgBox "Worksheet 'Program03' 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 Session As IpfcSession
    Dim model As pfcls.IpfcModel
    Dim Solid As IpfcSolid
    
    '// Current Model Information
    Set BaseSession = conn.Session
    Set model = BaseSession.CurrentModel
    Set Solid = model
    
    Worksheets("Program03").Cells(2, "D") = BaseSession.GetCurrentDirectory
    Worksheets("Program03").Cells(3, "D") = model.filename
     
    Dim SelectionOptions As New pfcls.CCpfcSelectionOptions
    Dim Selopt As pfcls.IpfcSelectionOptions
    Dim Selections As pfcls.IpfcSelections
    Dim Selection As IpfcSelection
    Dim ModelItem As IpfcModelItem
    Dim Surface As IpfcSurface
    
    Set Selopt = SelectionOptions.Create("surface")
    Selopt.MaxNumSels = 2
    Set Selections = BaseSession.Select(Selopt, Nothing)
    
    Dim i As Long
    
    For i = 0 To Selections.Count - 1
    
        Set Selection = Selections.item(i)
        Set ModelItem = Selection.SelItem
        Set Surface = ModelItem
        
        MsgBox Surface.EvalArea
   
    Next i
        
    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

---

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