UI를 사용 하여 어셈블리로 부품을 불러오기

□ 소개

Creo UI를 이용하여 조립을 하는 기능 입니다. 조립 위치는 "Automatic"으로 정의 됩니다.

 

TOOLBOX_VBA_UI_ASSY.xlsm

0.03MB

 

▷ 코드

Option Explicit
Sub intoAssemble()
    On Error GoTo RunError
    
    Application.EnableEvents = False
    
    '// Check if "Program01" worksheet exists
    If Not WorksheetExists("Program01") Then
        MsgBox "Worksheet 'Program01' 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 componentModel As IpfcSolid
    Dim Assembly As IpfcAssembly
    Dim Asmcomp As IpfcComponentFeat
    
    Dim createFileOpen As New CCpfcFileOpenOptions
    Dim FileOpenOptions As IpfcFileOpenOptions
    Dim creoFileName As String

    Set BaseSession = conn.Session
    Set Session = BaseSession
    Set model = BaseSession.CurrentModel
               
               
    '// Current Model Information
    Worksheets("Program01").Cells(2, "E") = BaseSession.GetCurrentDirectory
    Worksheets("Program01").Cells(3, "E") = model.filename
    
    '// Bring the name of the CREO model using the UI
    Set FileOpenOptions = createFileOpen.Create("*.prt")
    creoFileName = Session.UIOpenFile(FileOpenOptions)
    
    
    Dim createModelDescriptor As New CCpfcModelDescriptor
    Dim ModelDescriptor As IpfcModelDescriptor
    Dim createRetrieveModelOptions As New CCpfcRetrieveModelOptions
    Dim RetrieveModelOptions As IpfcRetrieveModelOptions
    
    Set ModelDescriptor = createModelDescriptor.Create(EpfcModelType.EpfcMDL_PART, "", "")
    ModelDescriptor.path = creoFileName
    
    Set RetrieveModelOptions = createRetrieveModelOptions.Create
    RetrieveModelOptions.AskUserAboutReps = False

    Set componentModel = BaseSession.RetrieveModelWithOpts(ModelDescriptor, RetrieveModelOptions)
    Set Assembly = model
    
    Dim Feature As IpfcFeature
    Dim matrix As New CpfcMatrix3D
    Dim createTransform3D As New CCpfcTransform3D
    Dim transform3D As IpfcTransform3D
    
    
    Dim i As Long
    Dim j As Long
    
    For i = 0 To 3
        For j = 0 To 3
            
            If i = j Then
                Call matrix.Set(i, j, 1#)
            Else
                Call matrix.Set(i, j, 0#)
            End If
            
        Next j
   Next i
    

   Set transform3D = createTransform3D.Create(matrix)
    
   Set Feature = Assembly.AssembleComponent(componentModel, transform3D)
    
    
    
    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