Excel VBA Study] Create a file name in Creo #2

엑셀의 유효성 검사 기능을 이용하여 Creo Part 파일을 생성할 수 있습니다. 입력 부분을 규칙적으로 강제화할 수 있습니다. 품번, 품명과 연결하여 활용할 수 있습니다.  엑셀 파일은 2개의 Sheet로 구성 돱니다. 유효성 검사 기능의 데이터 Sheet와 프로그램 동작을 하는 Sheet로 구성 됩니다.

You can create a Creo Part file using the validation function of Excel. You can enforce the input part regularly. You can use it by connecting it with the part number and part name. The Excel file consists of two Sheet. It consists of a data sheet for the validation function and a sheet for the program operation.

▣ data sheet

• ~~ name : 사용자 프로그램에서 선택할 수 있는 메뉴 이름 입니다.
• ~~ code : Creo Part 파일 이름에 조합되어 사용 돱니다
• Designer Name :  설계자 매개변수 이름 입니다.

 

• ~~ name: Menu name that can be selected in the user program.
• ~~ code: Used in combination with the Creo Part file name
• Designer Name: Designer parameter name

 

▣ Program sheet

• 프로그램 동작 화면 입니다. Project, Product Family, Location은 선택 하여 입력 합니다. Explain은 10자 이내오 입력 합니다. designer는 매개변수 이며, 선택 하여 입력 합니다.
• "Nwe Part File" 버튼을 클릭하면. "New Creo Part Name"가 자동으로 생성 되며, Creo 파일이 생성 됩니다.

 

• This is the program operation screen. Select and enter Project, Product Family, and Location. Enter Explain within 10 characters. Designer is a parameter, select and enter.
• When you click the "New Part File" button, a "New Creo Part Name" is automatically created, and a Creo file is created.

 

---

▷ Creo와 VBA를 연결하는 모듈 (Module that connects Creo and VBA)
        - Module Name : CreoVBAStart02

Option Explicit

Public asynconn As New pfcls.CCpfcAsyncConnection
Public conn As pfcls.IpfcAsyncConnection
Public BaseSession As pfcls.IpfcBaseSession

Public Sub CreoConnt02()
    On Error GoTo ErrorHandler   '// Setting up an error handler

    '// Creo Connection Settings
    Set conn = asynconn.Connect("", "", "", 5)
    Set BaseSession = conn.Session

    Exit Sub '// Terminates so that the flow does not go to the error handler.

ErrorHandler:
    '// Exception handling when Creo is not running
    If InStr(Err.Description, "XToolkitNotFound") > 0 Then
        MsgBox "Make sure Creo is running.", vbCritical, "error"
    Else
        MsgBox "An error occurred: " & Err.Description, vbCritical, "alarm"
    End If
End Sub

 

▷ 새로운 Part 파일 생성 코드  (New Part File Creation Code)

Option Explicit
Public CreoName As String

Sub CreoCreateName01()
    Dim wsForm As Worksheet
    Dim wsData As Worksheet
    
    Dim projectName As String
    Dim productFamily As String
    Dim locationName As String
    
    Dim projectCode As Variant
    Dim productCode As Variant
    Dim locationCode As Variant

    Set wsForm = ThisWorkbook.Worksheets("create model")
    Set wsData = ThisWorkbook.Worksheets("CR_DATA")
    
    '----- 값 읽기(Read value) -----
    projectName = wsForm.Range("C5").Value
    productFamily = wsForm.Range("D5").Value
    locationName = wsForm.Range("E5").Value
    
    '----- Project Code 가져오기 (Get Project Code)-----
    If projectName <> "" Then
        projectCode = Application.VLookup(projectName, wsData.Range("C3:D100"), 2, False)
        If Not IsError(projectCode) Then
            CreoName = projectCode
        Else
            wsForm.Range("C8").Value = "코드 없음" '// No code
        End If
    End If
    
    '----- Product family Code 가져오기 (Get Product family Code) -----
    If productFamily <> "" Then
        productCode = Application.VLookup(productFamily, wsData.Range("E3:F100"), 2, False)
        If Not IsError(productCode) Then
            CreoName = CreoName & productCode
        Else
            wsForm.Range("D8").Value = "코드 없음" '// No code
        End If
    End If

    '----- Location Code 가져오기 (Location Code) -----
    If locationName <> "" Then
        locationCode = Application.VLookup(locationName, wsData.Range("G3:H100"), 2, False)
        If Not IsError(locationCode) Then
             CreoName = CreoName & locationCode
        Else
            wsForm.Range("E8").Value = "코드 없음"  '// No code
        End If
    End If
    
    CreoName = CreoName & "_v01_" & ThisWorkbook.Worksheets("create model").Cells(5, "F")
    ThisWorkbook.Worksheets("create model").Cells(12, "D") = CreoName
    
    Call CreoCreateName02
 
End Sub

Sub CreoCreateName02()

     On Error GoTo RunError
     Application.EnableEvents = False
   
     '// Creo Connection
    Call CreoVBAStart02.CreoConnt02
       
    Dim model As IpfcModel
    Dim newmodel As IpfcModel
    Dim Window As IpfcWindow
    Dim part As IpfcPart
    Dim ModelDescriptorCreate As New CCpfcModelDescriptor
    Dim ModelDescriptor As IpfcModelDescriptor
    
    Call BaseSession.SetConfigOption("search_path", "F:\.shortcut-targets-by-id\17Yrp8FcmdhD6CTP9O_bP4-wAo6n_mZUF\idt_stds\start_files")
    
    Set ModelDescriptor = ModelDescriptorCreate.CreateFromFileName("start_part.prt")
    Set model = BaseSession.RetrieveModel(ModelDescriptor)
    Set newmodel = model.CopyAndRetrieve(CreoName, Null)
       
    Call newmodel.Display
    Set Window = BaseSession.GetModelWindow(newmodel)
    Call Window.Activate
       
    Dim ParameterOwner As IpfcParameterOwner
    Dim BaseParameter As IpfcBaseParameter
    Dim ParamValue As IpfcParamValue
    Dim DesignerParameter As String
    Dim ParamObject As New CMpfcModelItem
    
    Set ParameterOwner = newmodel
    Set BaseParameter = ParameterOwner.GetParam("DESIGNER")
    DesignerParameter = Worksheets("create model").Range("D6")
    Set ParamValue = ParamObject.CreateStringParamValue(DesignerParameter)
    BaseParameter.Value = ParamValue
       
     MsgBox "a Part file has been created..", 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

 

 

▷ youtu

 

엑셀의 유효성 검사 기능을 사용하면 오류 없이, 규칙적인 입력이 가능 합니다. 재질파일  지정을 효율적으로 입력 할수 있습니다.

Excel's validation function allows for error-free, regular input. You can enter material file specifications efficiently.

by korealionkk@gmail.com

---