ToolBOX VBA 1.5 개발 작업 #2

■ Component Info Sheet

- 사용자가 정의한 Parameter 이름을 모델에 추가 할 수 있습니다
- Material 파일을 선택 할수 있습니다.
- 선택한 Material 파일의 밀도 값을 이용하여, 자동으로 무게 계산 결과 값을 표시 합니다.

■ Material File List 관리 Sheet

- Material File이 모여 있는 폴더 이름을 표시 합니다
- Material File Name를 추가 할수 있습니다.
- Material File Name은 "Materia" Parameter의 값 입니다.
- Material File에 "밀도" 값이 있어야 합니다.

■ Component Info VBA 메뉴

1. Session OPen

- Creo 파일에 "Component Info"에 표시된 Parameter가 없으면 자동 추가 됩니다. 기본값이 자동으로 입력 됩니다
- Creo 파일에 "Component Info"에 표시된 Parameter가 있으면, 값만 표시됩니다.

2. Material

- "Material File Select"에 선택된 파일 이름이, "Materila" 항목에 자동으로 입력 됩니다
- "Weight" 항목에 무게 값이 자동으로 입력 됩니다
- "Assemble" 파일은 사용 하지 마십시요

3. Parameter Save

- 입력한 Parameter 값을 모델에 저장 합니다.
- Parameter 타입이 다르면 오류가 발생 합니다.
- "Parameter Save" 메뉴는 "Session OPen"메뉴 사용후 실행 해야 합니다

1. Session OPen 코드

Option Explicit
Sub Modelopen()

Application.EnableEvents = False
On Error GoTo RunError

        Dim asynconn As New pfcls.CCpfcAsyncConnection
        Dim conn As pfcls.IpfcAsyncConnection: Set conn = asynconn.Connect("", "", ".", 5)
        Dim oSession As pfcls.IpfcBaseSession: Set oSession = conn.session
        Dim oModel As IpfcModel: Set oModel = oSession.CurrentModel
        Dim oSolid As IpfcSolid: Set oSolid = oModel
        
        
        Call MaterialSelect
        
        
        '// Model Information Display
        
        Range("D4") = oModel.Filename
        Range("D5") = oSession.GetCurrentDirectory
        Range("D6") = Date
        
        
        
        '// Model Parameter Display
        
        Dim rng As Range
        Set rng = Range("E11", Cells(Rows.Count, "E").End(xlUp))
             
        Dim oBaseParameter As pfcls.IpfcBaseParameter
        Dim oParameterOwner As IpfcParameterOwner: Set oParameterOwner = oModel
        Dim oParameter As IpfcParameter
        Dim oParamValue As IpfcParamValue
        Dim oCMModelItem As New CMpfcModelItem
    
        Dim oModelItem As IpfcModelItem
        Dim oCellsParameterName, oCellsParameterType As String
              
        Dim i As Long

        
        For i = 0 To rng.Count - 1
    
            Set oBaseParameter = oParameterOwner.GetParam(Cells(i + 11, "E")) '// 엑셀의 PARAMETER 이름으로 모델의 PARAMETER 가져오기
            
            oCellsParameterType = Cells(i + 11, "F") '// 엑셀에서 PARAMETER 타입 가져오기
            
            If oBaseParameter Is Nothing Then
               
               If oCellsParameterType = "String" Then
                       Set oParamValue = oCMModelItem.CreateStringParamValue("IDT")

                ElseIf oCellsParameterType = "Real Number" Then
                       Set oParamValue = oCMModelItem.CreateDoubleParamValue(0)
               
                ElseIf oCellsParameterType = "True False" Then
                       Set oParamValue = oCMModelItem.CreateBoolParamValue(True)
                
                Else
                       Set oParamValue = oCMModelItem.CreateIntParamValue(0)

                End If
                 Set oBaseParameter = oParameterOwner.CreateParam(Cells(i + 11, "E"), oParamValue)
                  
            Else
            
              Set oParamValue = oBaseParameter.Value
            
              If oParamValue.discr = 0 Then
                  Cells(i + 11, "G") = oParamValue.StringValue
              
               ElseIf oParamValue.discr = 3 Then
                  Cells(i + 11, "G") = oParamValue.DoubleValue
                  
               ElseIf oParamValue.discr = "2" Then
                  Cells(i + 11, "G") = oParamValue.BoolValue
                   
               Else
                   Cells(i + 11, "G") = oParamValue.IntValue
              
               End If
               
            End If
                    
    Next i
           
    MsgBox "Creo File opened", vbInformation, "www.idt21c.com"
        
       conn.Disconnect (2)
    
    'Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set oSession = Nothing
    Set oModel = Nothing


Exit Sub
    
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
Sub MaterialSelect()

    Application.EnableEvents = False

'// Material File Select

    Sheets("Material").Select
    
    Dim rng As Range

        Set rng = Sheets("Material").Range("A5", Cells(Rows.Count, "A").End(xlUp))

    Dim i As Long
    Dim oMaterialFileName() As String
    ReDim oMaterialFileName(0 To rng.Count - 1)
    
        For i = 0 To rng.Count - 1
            oMaterialFileName(i) = rng.Cells(i + 5, "B")
    
        Next i
        
    Worksheets("Component Info").Select
      
    Dim region As Variant
    region = oMaterialFileName()

    
    Dim region_range As Range
    Set region_range = Cells(8, "D")
    
        With region_range.Validation
                   .Delete
                   .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Join(region, ",")
                   .IgnoreBlank = True
                   .InCellDropdown = True
                   .InputTitle = ""
                   .ErrorTitle = "Error"
                   .InputMessage = ""
                   .ErrorMessage = "Please Provide a Valid Input"
                   .ShowInput = True
                   .ShowError = True
                  End With

End Sub

2. Material 코드

Option Explicit
Sub Modelmaterial()

Application.EnableEvents = False
On Error GoTo RunError

        Dim asynconn As New pfcls.CCpfcAsyncConnection
        Dim conn As pfcls.IpfcAsyncConnection: Set conn = asynconn.Connect("", "", ".", 5)
        Dim oSession As pfcls.IpfcBaseSession: Set oSession = conn.session
        Dim oModel As IpfcModel: Set oModel = oSession.CurrentModel
        Dim oSolid As IpfcSolid: Set oSolid = oModel
        
        
        '// config.pro 옵션
        
        Dim oMaterialDir As String: oMaterialDir = Sheets("Material").Cells(3, "D")
        Call oSession.SetConfigOption("mass_property_calculate", "automatic")
        Call oSession.SetConfigOption("pro_material_dir", oMaterialDir)
        
        
        '//Material File Select
         Dim oMaterialFileName As String: oMaterialFileName = Replace(Cells(8, "D"), ".mtl", "")
         Cells(14, "G") = oMaterialFileName
         
         Dim oPart As IpfcPart: Set oPart = oSolid
         Dim oMaterial As IpfcMaterial: Set oMaterial = oPart.RetrieveMaterial(oMaterialFileName)
         
         oPart.CurrentMaterial = oMaterial
         
         '//Material Regenerate
         Dim regenInstrs As New CCpfcRegenInstructions
         Dim iRegenInstrs As IpfcRegenInstructions
         Set iRegenInstrs = regenInstrs.Create(False, True, Nothing)
         Call oSolid.Regenerate(iRegenInstrs)
         
         
         '//Mass Calculate
         Dim oMassProperty As IpfcMassProperty
         Set oMassProperty = oSolid.GetMassProperty("")
         Cells(18, "G") = oMassProperty.Mass
                 
        
         MsgBox "Materila File을 지정하였습니다", 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

3. Parameter Save 코드

Option Explicit
Sub modelparamsave()

Application.EnableEvents = False
On Error GoTo RunError

        Dim asynconn As New pfcls.CCpfcAsyncConnection
        Dim conn As pfcls.IpfcAsyncConnection: Set conn = asynconn.Connect("", "", ".", 5)
        Dim oSession As pfcls.IpfcBaseSession: Set oSession = conn.session
        Dim oModel As IpfcModel: Set oModel = oSession.CurrentModel
        Dim oSolid As IpfcSolid: Set oSolid = oModel
        
        
        Dim rng As Range
        Set rng = Range("E11", Cells(Rows.Count, "E").End(xlUp))
        
        
        Dim oPowner As pfcls.IpfcParameterOwner: Set oPowner = oModel
        Dim oBaseParameter As pfcls.IpfcBaseParameter
        Dim oParams As IpfcParameters
        Dim oParam As IpfcParameter
        Dim ParamObject As New CMpfcModelItem
        Dim oParamValue As pfcls.IpfcParamValue
        
        
        Dim oParamtype As String
        Dim oInteger As Integer
        Dim oDouble As Double
        Dim i As Integer
        
        Dim oStringvalue As String
        
        
        For i = 0 To rng.Count - 1
        
            Cells(i + 11, "F").Select
            oParamtype = ActiveCell.Value
            Set oParam = oPowner.GetParam(Cells(i + 11, "E"))
            Set oBaseParameter = oParam
            
            
            If oParamtype = "String" Then
                        
                        Set oParamValue = ParamObject.CreateStringParamValue(Cells(i + 11, "G"))
            
            ElseIf oParamtype = "Integer" Then

                        Set oParamValue = ParamObject.CreateIntParamValue(Cells(i + 11, "G"))

            ElseIf oParamtype = "True False" Then

                        Set oParamValue = ParamObject.CreateBoolParamValue(Cells(i + 11, "G"))
      
            Else
                        Set oParamValue = ParamObject.CreateDoubleParamValue(Cells(i + 11, "G"))
            
            End If
            
            oBaseParameter.Value = oParamValue
                    
        Next i
        
        oModel.Save
        
        MsgBox "Parameter를 저장 하였습니다", vbInformation, "www.idt21c.com"


       conn.Disconnect (2)
    
    'Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set oSession = Nothing
    Set oModel = Nothing


Exit Sub
    
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

■ 동영상

By lionkk@idt21c.com

저작자표시 비영리 변경금지

'Creo korea 임시 > ToolBOX Web , VBA 소식' 카테고리의 다른 글

자동 설계 및 검증 프로그램 개발 (0)	2023.07.11
ToolBOX VBA 1.5 개발 작업 #3 (0)	2022.12.25
ToolBOX VBA 1.5 개발 작업 #1 (0)	2022.12.15
N-001 ] PART List 기능 추가 및 이미지 파일 저장 위치 컨셉 (0)	2022.04.21
ToolBOX - FTP 서버 구축 (0)	2022.02.20