본문 바로가기
  • 환영 합니다 ! Welcome!
VBA For Creo

파일에서 Dimension 값 가져오는 프로그램

by ToolBOX01 2020. 12. 18.
반응형

Part의 치수값 가져오기. 어셈블의 치수 값 가져오기.  아래와 같은 구조의 객체 변수들을 사용한다.
모델 ▶ 솔리드 ▶ 모델 아이뎀 ▶ Dimension 순서로  이름 및 값을 가져 올수 있다.

▶ Interface IpfcModel 
    이 클래스는 현재 세션에있는 모델에 대한 정보를
    지정합니다.
Interface ipfcsolid
    이 클래스는 솔리드를 정의합니다.
Interface IpfcModelItemOwner
    모델 항목이 연결된 개체의 기본 클래스입니다.
Interface IpfcBaseDimension
   이 클래스는 Dimension 또는 참조 Dimension이 될 수있는
   기본 Dimension을 정의합니다.

사용 객체 구조

치수 이름이 "KOREA1"이 있으면 엑셀 파일에 치수 값을 표시하고, 없으면 표시 하지 않는다.
다음과 같은 순서로 코딩을 한다.

 

1. 현재 모델 Session 연결

 

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(1, 1) = session.GetCurrentDirectory
    Cells(1, 2) = oModel.Filename

 

2. 치수 이름 "KOREA1" 검색


    변수 oDIM (변수 타입 IpfcBaseDimension)에 "KOREA1" 치수 이름을 대입 합니다

 

    Dim oSolid As IpfcSolid
    Set oSolid = oModel
    Dim oWner As IpfcModelItemOwner
    Set oWner = oSolid
    Dim oDim As IpfcBaseDimension
    Dim oDimensionName As String
    oDimensionName = "KOREA1"

    Set oDim = oWner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, oDimensionName)

 

IpfcBaseDimension의 속성

1) DimType  : 치수 타입을 정의 합니다, 아라비아 숫자로 표시 합니다.
    "0" EpfcDIM_LINEAR - A linear dimension.
    "1" EpfcDIM_RADIAL - A radial dimension.
    "2" EpfcDIM_DIAMETER - A diametrical dimension.
    "3" EpfcDIM_ANGULAR - An angular dimension.
    "4" EpfcDimensionType_nil - Use this enumerated value to represent "null" passed to optional properties
                                          or method arguments.

2) DimValue : 치수 값을 정의 합니다.

3) Symbol : 치수 이름을 표시합니다.

 

3. 치수 값 엑셀에 표시 하기

 

    If oDimensionName = "KOREA1" Then
        Cells(5, 5) = oDim.DimValue
    End If

 

프로그램 전체 소스

 

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(1, 1) = session.GetCurrentDirectory
    Cells(1, 2) = oModel.Filename
    
    Dim oSolid As IpfcSolid
    Set oSolid = oModel
    Dim oWner As IpfcModelItemOwner
    Set oWner = oSolid
    Dim oDim As IpfcBaseDimension
    Dim oDimensionName As String
    oDimensionName = "KOREA1"

    Set oDim = oWner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, oDimensionName)
    If oDimensionName = "KOREA1" Then
        Cells(5, 5) = oDim.DimValue
    End If
    
    'Disconnect with Creo
    conn.Disconnect (2)
    
    'Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set session = Nothing
    Set oModel = Nothing
End Sub

소스를 응용한 프로그램 만들기

아래 그림에서 Dimension 이름으로  Dimenosion 값을 가져오는 프로그램을 개발하여 봅니다. CREO의 DIMENSION 이름과 엑셀 파일의 이름이 동일해야 합니다. 대소 무바를 구분 합니다. 반드시 대문자로 통일 해서 사용합니다.

■ 엑셀에서 Dimmension name의 항목 개수를 카운트 하는 코딩이 필요하다. 프로그램을 짠다는것은 1,00개 이상을
   반복적으로 수행 한다는것 입니다. 현재는 3개이지만. . .  수십, 수백인 경우를 대비 해야 합니다 

 

Dim rng As Range, C As Range
Dim dc As New Collection
Set rng = Range("E5", Cells(Rows.Count, "E").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

■DiMENSION 이름을 읽는 코딩

 

Dim oDimensionName As String
For i = 1 To dc.Count
     oDimensionName = Cells(i+4, "E")
     Set oDim = oWner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, oDimensionName)
     Cells(i+4, "F") = oDim.DimValue
    End If     
Next

 

■ 소스 코딩

 

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(1, 1) = session.GetCurrentDirectory
    Cells(1, 2) = oModel.Filename
    
    Dim rng As Range, C As Range
    Dim dc As New Collection
    Set rng = Range("E5", Cells(Rows.Count, "E").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 = 1 To dc.Count
        oDimensionName = Cells(i + 4, "E")
        Set oDim = oWner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, oDimensionName)
        Cells(i + 4, "F") = oDim.DimValue
    Next
    
    'Disconnect with Creo
    conn.Disconnect (2)
    
    'Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set session = Nothing
    Set oModel = Nothing
End Sub