본문 바로가기
  • Welcome!
VBA For Creo

모델이 가지고 있는 치수 값을 가지고 오기

by ToolBOX01 2023. 1. 14.
반응형

모델이 가지고 있는 특정 이름을 갖는 치수의 값을 가져오는 코드 입니다. FOR 문을 사용 하면 간결하고, 치수 이름이 추가되어도 대응이 가능 합니다. 초보적인 내용을 올립니

○ 모델의 치수 이름

 엑셀 Sheet

 

Option Explicit
Sub Main()

    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
    
    
    '// 활성화된 모델의 폴더 이름과 모델 이름을 표시
    Cells(1, "B") = oSession.GetCurrentDirectory
    Cells(2, "B") = oModel.Filename
    
    
    
    '// 엑셀에 정의 되어 있는 치수 이름의 값을 가지고 오기
    
     Dim Modelowner As IpfcModelItemOwner: Set Modelowner = oSolid
     Dim Dimwidth As IpfcBaseDimension
     Set Dimwidth = Modelowner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, "WIDTH01")
     
     Cells(5, "A") = Dimwidth.DimValue
     
     
     Dim Dimheight As IpfcBaseDimension
     Set Dimheight = Modelowner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, "HEIGHT01")
     
     Cells(5, "B") = Dimheight.DimValue
    
     
     Dim Dimdepth As IpfcBaseDimension
     Set Dimdepth = Modelowner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, "DEPTH01")
     
     
     Cells(5, "C") = Dimdepth.DimValue
    
   
     MsgBox "치수 값을 모두 표시 하였습니다", 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

 

모델 치수 이름의 값을 가져오는 기능은 IpfcModelItemOwner.GetItemByName()을 사용 합니다.
EpfcModelItemType은 "EpfcITEM_DIMENSION"를 선택하고, 문자 타입으로 치수 이름을 넣습니다 ( 예, "WIDTH01")

"WIDTH01" 치수에서 가져온 것은  "IpfcBaseDimension"으로 전달 받습니다. 변수 이름은 "Dimwidth"으로 정의 하였습니다.  Cells(5, "A")에 "Dimwidth"의 치수 값을 표시 합니다

주의 사항>
CREO 치수의 이름은 대/소문자를 구분 합니다. 습관상 대문자로 모두 입력 합니다. 특수 문자는 "_"만 사용 가능 합니다

01 VBA Dimension.xlsm
0.02MB
box01.prt.1
0.08MB

 

* VBA 개발 도구에서 실행 하십시요. 실행 버튼은 만들지 않았습니다. 


FOR 문 사용 하기 

Option Explicit
Sub Main()

    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
    
    
    '// 활성화된 모델의 폴더 이름과 모델 이름을 표시
    Cells(1, "B") = oSession.GetCurrentDirectory
    Cells(2, "B") = oModel.Filename
    
    
    '// 엑셀에 정의 되어 있는 치수 이름의 값을 가지고 오기
    
    
     Dim Modelowner As IpfcModelItemOwner: Set Modelowner = oSolid
     Dim oBaseDimension As IpfcBaseDimension
     
     Dim oDimName As String
     Dim i As Integer
     
     For i = 0 To 2
    
         oDimName = Cells(4, i + 1)
         Set oBaseDimension = Modelowner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, oDimName)
         Cells(5, i + 1) = oBaseDimension.DimValue
     
     Next i
      
    
   
     MsgBox "치수 값을 모두 표시 하였습니다", 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

 

FOR 문을 사용하면 중복된 코드를 삭제 할수 있고, 유지  보수도 쉽습니다.
위 코드에서 치수 이름이 늘어나면  "For i = 0 to 3"의 "3" 값을 변경 해야 합니다.  열의 갯수를 자동으로 카운트 하는 코드를 넣으면 , 엑셀 파일과 모델에에 치수 이름만 넣으면 됩니다. 만들고 -> 사용하고- >개선 하고 -> 사용하고  무한 루프를 합니다. 

 

조만가 다가올 현실 - 인공지능이 코딩 해주는 시대

 

'VBA For Creo' 카테고리의 다른 글

IpfcWindow  (0) 2023.01.16
엑셀에서 치수값을 입력 하여 모델 변경 하기  (0) 2023.01.14
Creo VBA 시작 코드  (0) 2023.01.14
Coordinate Systems and Transformations  (0) 2023.01.13
Part List & BOM & Access DB  (0) 2023.01.12