Creo 서피스 분석

□ Feature를 구성 하고 있는 서피를 분석 합니다

• 모델 이미지

• 서피스 분석

번호 2는 서피스 분석 결과 면적이 "50"이고. 평면 타입 입니다. 이것은 Feature 9에 속해 있습니다.
U,V 는 표면 모서리의 OUTLine 2차원 위치 입니다. 기준은 모델의 기본 자표계 입니다. U (X)방향으로 10 V(Y) 방향으로 5만 만큼 위치에 있습니다. X,Y.Z 로 할수 있습니다. 

U V 란?

솔리드 모델을 구성 하고 있는 서피스의  OUTLine 크기는 UV 로 2차원으로 표시 합니다. U.V의 기준 위치(포인트)는 X,Y,Z로 표시 합니다.  기본 좌표계를 기준으로  표시 합니다. 서피스 Feature는 측정 할수 없습니다.

• 예시 Creo 화면

 

 

• 프로그램  실행 결과   

 

• 대칭 구조 서피스 분석

- 방향은 측정이 안되는 경우가 있습니다

 

□ 코드

Option Explicit
Sub SurfaceID()
    On Error GoTo RunError
    
    Application.EnableEvents = False
    
    '// Check if "Program04" worksheet exists
    If Not WorksheetExists("Program04") Then
        MsgBox "Worksheet 'Program04' 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("Program04").Cells(2, "D") = BaseSession.GetCurrentDirectory
    Worksheets("Program04").Cells(3, "D") = model.filename
    
    '// Bring the name of the Feature Type
    
     Dim Modelowner As IpfcModelItemOwner:
     Dim ModelItems As IpfcModelItems
     Dim ModelItem As IpfcModelItem
     Dim feature As IpfcFeature
     Dim Surface As IpfcSurface
     
     Dim UVOutline As IpfcUVOutline
     Dim UVParams As IpfcUVParams
     Dim SurfXYZData As IpfcSurfXYZData
     Dim Point3D As IpfcPoint3D
    
     Set Modelowner = model
     Set ModelItems = Modelowner.ListItems(EpfcModelItemType.EpfcITEM_SURFACE)
     
     Dim i As Long
    
     For i = 0 To ModelItems.Count - 1
          
          Set ModelItem = ModelItems(i)
          Set Surface = ModelItem
          Set feature = Surface.GetFeature
          Set UVOutline = Surface.GetUVExtents
          Set UVParams = UVOutline.item(0)
          Set UVParams = UVOutline.item(1)
          
          Set SurfXYZData = Surface.Eval3DData(UVParams)
          Set Point3D = SurfXYZData.Point
          
          Cells(i + 6, "B") = i + 1
          Cells(i + 6, "C") = Surface.EvalArea
          Cells(i + 6, "D") = Surface.GetSurfaceType
          Cells(i + 6, "E") = feature.Number
          
          Cells(i + 6, "F") = UVParams.item(0)
          Cells(i + 6, "G") = UVParams.item(1)

          Cells(i + 6, "H") = Point3D.item(0)
          Cells(i + 6, "I") = Point3D.item(1)
          Cells(i + 6, "J") = Point3D.item(2)
           
     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
Sub DeleteBelowAndRight()
    Dim ws As Worksheet
    Dim rngToDelete As Range
    Dim rowToDelete As Long
    Dim colToDelete As Long

    '// 원하는 시트를 지정합니다.
    Set ws = ThisWorkbook.Sheets("Program04") ' 시트명을 수정하세요.

     '// 삭제할 행과 열을 찾습니다.
    rowToDelete = ws.Range("B6").Row
    colToDelete = ws.Range("B6").Column

    '// 삭제할 범위를 정의합니다.
    Set rngToDelete = ws.Range(ws.Cells(rowToDelete, colToDelete), _
                                ws.Cells(ws.Rows.Count, colToDelete).End(xlUp))

    '// 정의한 범위를 삭제합니다.
    rngToDelete.Delete Shift:=xlToLeft
End Sub