Get Creo drawing view name and location values

You can get all view names contained in a drawing file.

Get the view names contained in multiple drawing sheets. I don't know which sheet it is included in. I didn't add any code.Displays the center position values ​​of the view as "X", "Y"

 

▷ Creo and VBA Connection Library Code

Option Explicit
Public asynconn As New pfcls.CCpfcAsyncConnection
Public conn As pfcls.IpfcAsyncConnection
Public BaseSession As pfcls.IpfcBaseSession
Public model As pfcls.IpfcModel
Public Sub CreoConnt01()
     
     '// connect creo model
     Set conn = asynconn.Connect("", "", ".", 5)
     Set BaseSession = conn.Session
     Set model = BaseSession.CurrentModel
     
    '// creo model connection check
     If model Is Nothing Then
        MsgBox "There are No Active Creo Models", vbInformation, "korealionkk@gmail.com"
        Exit Sub
     End If
          
End Sub

 

CreoDrawingVBAStart.bas

0.00MB

 

▷ Main Code 1

Option Explicit
Sub Drawing01()
    On Error GoTo RunError

    '// Module Name : CreoVBAStart
    Call CreoVBAStart.CreoConnt01
    
    Dim Model2D As IpfcModel2D
    Dim View2Ds As IpfcView2Ds
    Dim Transform3D As IpfcTransform3D
    Dim ViewOrigin As IpfcPoint3D
    Dim i As Integer
    
    Set Model2D = BaseSession.CurrentModel
    Set View2Ds = Model2D.List2DViews
    
    
    For i = 0 To View2Ds.Count - 1
    
    Set Transform3D = View2Ds.Item(i).GetTransform
    Set ViewOrigin = Transform3D.GetOrigin
    
    Worksheets("drawing01").Cells(i + 6, "A") = i + 1
    Worksheets("drawing01").Cells(i + 6, "B") = View2Ds.Item(i).Name
    Worksheets("drawing01").Cells(i + 6, "C") = ViewOrigin.Item(0)
    Worksheets("drawing01").Cells(i + 6, "D") = ViewOrigin.Item(1)
    
    Next i
    

     '// MsgBox "I brought all the part names.", vbInformation, "korealionkk@gmail.com"
    
    conn.Disconnect (2)
    
    
    '// Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set BaseSession = Nothing
    Set model = Nothing
    
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

 

DrawingViewnameLocation.cls

0.00MB

---

▷ Main Code 2

Displays the sheet number.

Option Explicit
Sub Drawing01()
    On Error GoTo RunError

    '// Module Name : CreoVBAStart
    Call CreoVBAStart.CreoConnt01
    
    Dim Model2D As IpfcModel2D
    Dim View2Ds As IpfcView2Ds
    Dim Transform3D As IpfcTransform3D
    Dim ViewOrigin As IpfcPoint3D
    Dim i As Integer
    
    Set Model2D = BaseSession.CurrentModel
    Set View2Ds = Model2D.List2DViews

    
    For i = 0 To View2Ds.Count - 1
    
            Set Transform3D = View2Ds.Item(i).GetTransform
            Set ViewOrigin = Transform3D.GetOrigin

            Worksheets("drawing01").Cells(i + 6, "A") = i + 1
            Worksheets("drawing01").Cells(i + 6, "B") = View2Ds.Item(i).Name
            Worksheets("drawing01").Cells(i + 6, "C") = ViewOrigin.Item(0)
            Worksheets("drawing01").Cells(i + 6, "D") = ViewOrigin.Item(1)
            Worksheets("drawing01").Cells(i + 6, "E") = View2Ds.Item(i).GetSheetNumber
    
    Next i
    

     'MsgBox "I brought all the Drawing View names.", vbInformation, "korealionkk@gmail.com"
    
    conn.Disconnect (2)
    
    
    '// Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set BaseSession = Nothing
    Set model = Nothing
    
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

 

DrawingViewnameLocation.cls

0.00MB

 

by : korealionkk@gmail.com