Template Model] 자동으로 치수 변경

■ 모델의 치수 값 불러오기

>> "DIM" 버튼 코드

Option Explicit
Public asynconn As New pfcls.CCpfcAsyncConnection
Public conn As pfcls.IpfcAsyncConnection
Public oSession As pfcls.IpfcBaseSession
Public oModel As IpfcModel
Sub DIM_TEST01()

    Application.EnableEvents = False
    
    On Error GoTo RunError
        
        '// Make an asynchronous connection with Creo
        Set conn = asynconn.Connect("", "", ".", 5)
        Set oSession = conn.Session
        Set oModel = oSession.CurrentModel
        
        '// File Information
        Cells(4, "B") = oSession.GetCurrentDirectory
        Cells(5, "B") = oModel.Filename
        
        Dim oSolid As IpfcSolid: Set oSolid = oModel
        Dim oModelItemOwner As IpfcModelItemOwner: Set oModelItemOwner = oSolid
        Dim oDimValue As IpfcBaseDimension
        
        '// Dimension Display
        Dim rng As Range
        Set rng = Range("A8", Cells(rows.Count, "A").End(xlUp))
        
        Dim i, oDimType As Long
        
        For i = 0 To rng.Count - 1
              
            Set oDimValue = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, Cells(i + 8, "B"))
            
                If oDimValue Is Nothing Then
                
                    Cells(i + 8, "D") = "치수 이름 다름"
                
                Else
                
                    Cells(i + 8, "C") = oDimValue.DimValue
                    oDimType = oDimValue.DimType
                    
                        If oDimType = 0 Then
                            
                            Cells(i + 8, "E") = "LINEAR"
                        
                        ElseIf oDimType = 1 Then
                            
                            Cells(i + 8, "E") = "RADIAL"
                        
                        ElseIf oDimType = 2 Then
                            
                            Cells(i + 8, "E") = "DIAMETER"
                        
                        ElseIf oDimType = 3 Then
                            
                            Cells(i + 8, "E") = "ANGULAR"
                        
                        Else
                        
                            Cells(i + 8, "E") = "NULL"
                        
                        End If
                                            
                End If
            
        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

[엑셀 VBA] On Error문을 이용한 에러 제어 방법

VBA에서는 코드 실행 시 Error가 발생할 때, 제어할 수 있는 방법을 몇 가지 제공하고 있는데 그중 대표적인 방법이 [On Error] 문이다. [On Error] 즉, Error가 발생할 시, [~~] 어떻게 행동하라는 코드를 작

separang.tistory.com

>> "REGEN" 버튼 코드

Sub DIM_REGEN01()

    Application.EnableEvents = False
    
    On Error GoTo RunError
    
    
    '// Make an asynchronous connection with Creo
    Set conn = asynconn.Connect("", "", ".", 5)
    Set oSession = conn.Session
    Set oModel = oSession.CurrentModel
    
    
    Dim oSolid As IpfcSolid: Set oSolid = oModel
    Dim oModelItemOwner As IpfcModelItemOwner: Set oModelItemOwner = oSolid
    Dim oDimValue As IpfcBaseDimension
        
    '// Dimension Display
    Dim rng As Range
    Set rng = Range("A8", Cells(rows.Count, "A").End(xlUp))
    
    '// SET Regenerate
    Dim RegenInstructions As New CCpfcRegenInstructions
    Dim oInstrs As IpfcRegenInstructions
    Set oInstrs = RegenInstructions.Create(False, False, Nothing)
    
        
    Dim j As Long
    
    For j = 0 To rng.Count - 1
    
        Set oDimValue = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, Cells(j + 8, "B"))
    
        oDimValue.DimValue = Cells(j + 8, "C")
        
        '// Regenerate 실행
        Call oSolid.Regenerate(oInstrs)
        Call oSolid.Regenerate(oInstrs)
        
        Cells(j + 8, "D") = "OK"
    
    
    Next j

     
     '// Window Repaint
     Dim oWindow As pfcls.IpfcWindow
     Set oWindow = oSession.CurrentWindow
     oWindow.Repaint
     
    
    
    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

치수 이름에 여러개의 값을 넣어 보고, 모델에 오류가 있는지 체크 하는 프로그램 입니다. Template 모델을 만들면, 매우 많은 치수 값을 넣어 보고 모델에 오류가 있는지 파악해야 합니다.

- Model Dim
Template 모델이 가지고 있는 치수 "값" 입니다.

- Dim Name CheckDifferent
모델의 치수 이름과 비교하는 기능 입니다. 만일 다르면 "Different" 가표시 됩니다.

재생성 오류가 발생 하면 Cell의 배경 색상은 빨강색 입니다.

■ 프로그램 테스트

치수 이름 "X001"의 값에 여러개의 값을 넣고 재-생성 기능을 실행 합니다.

■ 코드

Sub TEMPDIM02()


    Application.EnableEvents = False
    
    On Error GoTo RunError
    
    
    '// Make an asynchronous connection with Creo
    Set conn = asynconn.Connect("", "", ".", 5)
    Set oSession = conn.Session
    Set oModel = oSession.CurrentModel
    
    
    Dim oSolid As IpfcSolid: Set oSolid = oModel
    Dim oModelItemOwner As IpfcModelItemOwner: Set oModelItemOwner = oSolid
    Dim oDimValue As IpfcBaseDimension
    
    Dim oFailedFeatures As IpfcFeatures
        
    '// Dimension Display
    Dim rng As Range
    Set rng = Range("B9", Cells(rows.Count, "B").End(xlUp))
    
    
     '// SET Regenerate
    Dim RegenInstructions As New CCpfcRegenInstructions
    Dim oInstrs As IpfcRegenInstructions
    Set oInstrs = RegenInstructions.Create(False, False, Nothing)
       
    Dim j As Long
    
    For j = 0 To rng.Count - 1
    
         Set oDimValue = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, Cells(8, "B"))
    
        oDimValue.DimValue = Cells(j + 9, "B")
        
        '// Regenerate 실행
        On Error Resume Next
            Call oSolid.Regenerate(oInstrs)
        On Error Resume Next
            Call oSolid.Regenerate(oInstrs)
            
        '// Regenerate Fail Check
        Set oFailedFeatures = oSolid.ListFailedFeatures
        
        If Not oFailedFeatures Is Nothing Then
        
            Cells(j + 9, "B").Interior.ColorIndex = 3
            
        End If

    
    Next j
    
    
    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

'// Regenerate 실행
On Error Resume Next
Call oSolid.Regenerate(oInstrs)

"On Error Resume Next" 기능으로 "Regenerate" 오류가 발생 해도 다음 단계로 넘어 갈수 있습니다.

'// Regenerate 오류 체크
Set oFailedFeatures = oSolid.ListFailedFeatures
If Not oFailedFeatures Is Nothing Then
Cells(j + 9, "B").Interior.ColorIndex = 3
End If

모델 자체에 오류가 발생하면 치수 값 배경 색상을 빨강 색으로 표시 합니다

>> 참고 사이트

[엑셀 VBA] 가능한 모든 조합 나열하기

개인적으로 필요해서 SPSS의 집단별 통계 기능을 엑셀로 만들고 있는 중이다. 이 매크로는 그 과정의 시작 단계라 할 수 있겠다. 집단별 변수값에 따라 만들 수 있는 모든 조합을 나열한다. 예를

ruahneuma.tistory.com

변경 가능 한 치수의 값들을 조합하는 전체 경우 수를 찾아야 합니다. 먼저 행의 갯수를 찾아야 합니다

'// Dimenson Name Count
lastColumn = Cells(8, Columns.Count).End(xlToLeft).Column -1 '// "1" 값은 보정 값 입니다

열의 갯수를 찾아야 합니다.
lastRow = Cells(rows.Count, i + 2).End(xlUp).row - 8 '// "8" 값은 보정 값 입니다

조합이 가능한 총 갯수는 "8 * 8* ~ *5 * 3" 입니다. 조합 가능한 경우의 수는 총 "11,059,200" 입니다

Template 모델 생성시 조합 하는 치수들이 너무 많으면 VBA 프로그램으로 모델을 변경 하는것이 현실적으로 어렵습니다. 모델을 변경 할 수 있는 치수 이름 개수를 제한 헤야 합니다. 또한 변경 가능한 값들도 줄여야 합니다.

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

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

Part List & BOM & Access DB (0)	2023.01.12
BOM LEVEL 표시 방법 (0)	2023.01.06
라이브러리 관리 프로그램 #2 (0)	2023.01.03
Family Table Part (1)	2023.01.01
라이브러리 관리 프로그램 #1 (0)	2022.12.28