엑셀의 치수 값을 모델로 보내기

1. 모델의 치수 이름은 정의 되어 있어야 합니다.

2. 엑셀 UI

엑셀

---

코딩하기

1. 단계 연결 및 파일 이름 표시

 

Sub dim_Value()
    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection
    Set conn = asynconn.Connect("", "", ".", 5)
    Dim session As pfcls.IpfcBaseSession
    Set session = conn.session
    Dim oModel As pfcls.IpfcModel
    Set oModel = session.CurrentModel
    
    Cells(2, "D") = session.GetCurrentDirectory
    Cells(3, "D") = oModel.Filename

 

2. 셀의 치수  이름 배열 하기

    "KOREA1 ~ KOREA3"  이름을 범위로 정의 하고, 카운트를 정의 합니다 - 무척 많이 사용하는 코딩 입니다

 

    Dim rng As Range, C As Range
    Dim dc As New Collection
    Set rng = Range("C6", Cells(Rows.Count, "C").End(xlUp))

    On Error Resume Next
    For Each C In rng
        If Len(C) Then
           dc.Add Trim(C), CStr(Trim(C))
        End If
    Next
    On Error GoTo 0

 

3. 배열을 하고 엑셀 파일에 치수 값 표시 하기

 

    Dim oSolid As IpfcSolid
    Set oSolid = oModel
    Dim oWner As IpfcModelItemOwner
    Set oWner = oSolid
    Dim oDim As IpfcBaseDimension
    Dim oDimensionName As String
 
    For i = 0 To dc.Count - 1
            oDimensionName = Cells(i + 6, "c")
            Set oDim = oWner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, oDimensionName)
            If oDimensionName = oDim.Symbol Then
                Cells(i + 6, "d") = oDim.DimValue
            End If
    Next i

 

모델에서 치수 이름을 추가 하고, 엑셀 파일에서 치수 이름을 추가 하면 자동으로 치수 값을 표시 할수 있습니다.
FOR문과 Rows.count 명령을 사용한 이유 입니다.

 

전체 소스

 

Sub dim_Value_display()
    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection
    Set conn = asynconn.Connect("", "", ".", 5)
    Dim session As pfcls.IpfcBaseSession
    Set session = conn.session
    Dim oModel As pfcls.IpfcModel
    Set oModel = session.CurrentModel
    
    Cells(2, "D") = session.GetCurrentDirectory
    Cells(3, "D") = oModel.Filename
    
   Dim rng As Range, C As Range
   Dim dc As New Collection
   Set rng = Range("C6", Cells(Rows.Count, "C").End(xlUp))

    On Error Resume Next
    For Each C In rng
        If Len(C) Then
           dc.Add Trim(C), CStr(Trim(C))
        End If
    Next
    On Error GoTo 0
    
    Dim oSolid As IpfcSolid
    Set oSolid = oModel
    Dim oWner As IpfcModelItemOwner
    Set oWner = oSolid
    Dim oDim As IpfcBaseDimension
    Dim oDimensionName As String
 
    For i = 0 To dc.Count - 1
            oDimensionName = Cells(i + 6, "c")
            Set oDim = oWner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, oDimensionName)
            If oDimensionName = oDim.Symbol Then
                Cells(i + 6, "d") = oDim.DimValue
            End If
    Next i
    
    
    'Disconnect with Creo
    conn.Disconnect (2)
    
    'Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set session = Nothing
    Set oModel = Nothing
End Sub

 

---

엑셀 파일에서 치수 값 변경 하기

" oDim.DimValue = Cells(i + 6, "d")" 엑셀의 치수 값을 Creo 의 치수로 전달 하는 코딩 입니다.

 

Sub dim_Value()

    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection
    Set conn = asynconn.Connect("", "", ".", 5)
    Dim session As pfcls.IpfcBaseSession
    Set session = conn.session
    Dim oModel As pfcls.IpfcModel
    Set oModel = session.CurrentModel
    
    Dim rng As Range, C As Range
    Dim dc As New Collection
    Set rng = Range("C6", Cells(Rows.Count, "C").End(xlUp))

    On Error Resume Next
    For Each C In rng
        If Len(C) Then
           dc.Add Trim(C), CStr(Trim(C))
        End If
    Next
    On Error GoTo 0
    
    Dim oSolid As IpfcSolid
    Set oSolid = oModel
    Dim oWner As IpfcModelItemOwner
    Set oWner = oSolid
    Dim oDim As IpfcBaseDimension
    Dim oDimensionName As String
    Dim oDimensionValue As Double
    
    For i = 0 To dc.Count - 1
            oDimensionName = Cells(i + 6, "c")
            Set oDim = oWner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, oDimensionName)
            If oDimensionName = oDim.Symbol Then
               oDim.DimValue = Cells(i + 6, "d")
            End If
    Next i
    
    Dim Solid As IpfcSolid
    Set Solid = oModel
    Solid.Regenerate (ForceRegen)

End Sub

 

Creo 파일은 4.0 버전입니다.

dim-value01.prt.1

0.08MB

dim-value01.xlsm

0.02MB

동영상