도면에 배치된 뷰-이름 가져오기

□ 도면에 배치된 뷰-이름을 가져오는 코드 입니다

* VBA 프로그램에서 뷰 이름 순서는 생성 순서로 표시됩니다 

□  코드

IpfcModel2D. List2DViews를 활용합니다

Dim Model2D As IpfcModel2D
Dim View2Ds As IpfcView2Ds
Dim i As Integer    
Set Model2D = model
Set View2Ds = Model2D.List2DViews
    
    For i = 0 To View2Ds.Count - 1
        Worksheets("Program04").Cells(i + 5, "D") = View2Ds.item(i).Name
    Next i

 

□  전체 코드

Option Explicit
Sub Drawing_view_name_list()
    On Error GoTo RunError
    
    Application.EnableEvents = False
    
    '// Check if "Program03" 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 Session As IpfcSession
    Dim model As pfcls.IpfcModel
    Dim Solid As IpfcSolid
    
    '// Current Model Information
    Set BaseSession = conn.Session
    Set model = BaseSession.CurrentModel

    Worksheets("Program04").Cells(2, "D") = BaseSession.GetCurrentDirectory
    Worksheets("Program04").Cells(3, "D") = model.filename
        
    Dim Model2D As IpfcModel2D
    Dim View2Ds As IpfcView2Ds
    Set Model2D = model
    Set View2Ds = Model2D.List2DViews
    
    Dim i As Integer
    
    For i = 0 To View2Ds.Count - 1
    
        Worksheets("Program04").Cells(i + 5, "D") = View2Ds.item(i).Name

    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

▷ 프로그램 실행 결과