본문 바로가기
  • Welcome!
VBA For Creo

IpfcViewOwner를 이용한 회전 뷰 증강 모델 파일 생성

by ToolBOX01 2023. 1. 18.
반응형

Creo 화면의 좌측 하단의 중심축 (2차원)의  "X" 축을 기준으로 일정한 값을 증강 하는 JPG 파일을 생성 합니다.
프로그램 화면에서 증가 각도 값을 입력 합니다.

[ 프로그램 화면 ]

>> 회전 하는 코드

Option Explicit
Sub rotate_model()

    Application.EnableEvents = False
    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection:
    
    '//////////////////////////////////////////////////////////////////////////////////////////////////////
    '// Creo Connect Check
    '//////////////////////////////////////////////////////////////////////////////////////////////////////
    On Error Resume Next
    Set conn = asynconn.Connect("", "", ".", 5)
    
        If conn Is Nothing Then
        
           MsgBox "Error occurred while starting new Creo Parametric Session!", vbInformation, "www.idt21c.com"
           Exit Sub
           
        End If
     '//////////////////////////////////////////////////////////////////////////////////////////////////////

    On Error GoTo RunError
    
    Dim oSession As pfcls.IpfcBaseSession: Set oSession = conn.Session
    Dim oModel As IpfcModel: Set oModel = oSession.CurrentModel
    Dim oWindows As IpfcWindow: Set oWindows = oSession.CurrentWindow
    
    '//////////////////////////////////////////////////////////////////////////////////////////////////////
    '// Active Models Check
    '//////////////////////////////////////////////////////////////////////////////////////////////////////
        If oModel Is Nothing Then
            
           MsgBox "No Active Models!", vbInformation, "www.idt21c.com"
           Exit Sub
        
        End If
    '//////////////////////////////////////////////////////////////////////////////////////////////////////
    
    Cells(3, "B") = oModel.Filename '// Model Name
    Dim oFolderName As String: oFolderName = Cells(4, "B") '//JPG image storage location
    Dim oRotateAngle, oCount As Double
    
    oRotateAngle = Cells(5, "B") '// Input Angle
    oCount = 360 / oRotateAngle
    
    Dim i As Double
    
    Dim oViewOwner As IpfcViewOwner: Set oViewOwner = oModel
    
    For i = 0 To oCount - 1
    
        Call oViewOwner.CurrentViewRotate(0, oRotateAngle)
        oWindows.Refresh
        
        MsgBox "Rotate" & i + 1
    
    Next i
    
    MsgBox "Completed Model Rotation", vbInformation, "www.idt21c.com"
        
    conn.Disconnect (2)
    
    'Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set oSession = Nothing
    Set oModel = Nothing
    
RunError:
    If Err.Number <> 0 Then
        MsgBox "Process Failed : Unknown error occurred." + Chr(13) + _
                "Error No: " + CStr(Err.Number) + Chr(13) + _
                "Error: " + Err.Description, vbCritical, "Error"
        If Not conn Is Nothing Then
            If conn.IsRunning Then
                conn.Disconnect (2)
            End If
        End If
    End If

End Sub

screen coordinate system.xlsm
0.02MB

>> JPG 파일 생성 코드

 

이미지 변환 프로그램 소스

■ jpg 변경 프로그램 Option Explicit Sub A3PartListJpgExport() On Error GoTo RunError Dim asynconn As New pfcls.CCpfcAsyncConnection Dim conn As pfcls.IpfcAsyncConnection: Set conn = asynconn.Connect("", "", ".", 5) Dim oSession As pfcls.IpfcBaseSes

tool-2020.tistory.com

 

[ 입력한 각도 값으로 "x"축을 증가 하여, 회전  이미지 생성 ] 

 

>> 프로그램  Download

screen coordinate system.xlsm
0.03MB


'VBA For Creo' 카테고리의 다른 글

Spur 기어 #2  (0) 2023.01.25
CREO 내부에서 엑셀 파일 실행 방법  (0) 2023.01.20
Webgl Test] Creo 파일 Web 브라우저 게시  (0) 2023.01.17
IpfcViewOwner  (0) 2023.01.16
IpfcWindow  (0) 2023.01.16