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

측정 Feature의 매개변수 값 가져오기 #3

by ToolBOX01 2022. 9. 16.
반응형

모델의 치수 "DIM01", "DIM02", "DIM03"의 값을 자동으로  변경 합니다. "MASS" 매개 변수값을 표시 합니다.

 

Template Model 최종 Model

치수 변수 이름은 다음과 같습니다. 반드시 영문자 대문자로 시작 해야 합니다. 치수 값을 최종 목표 값으로 변경 하면, MODEL에 오류가 없어야 합니다.  

 

1) DIM01

2) DIM02

3) DIM03

 

"MASS " 로컬 매개변수는 측정 Feature "GRAVITY"안에 있습니다. 

 

주의 사항 - 치수 변경)

Creo가 제공하는 프로그램 개발도구를 사용하여, Model의 치수 값을 변경 하려면 반드시 Config.pro > 
Regen_failure_handling 을 "resolve_mode"로 변경후 프로그램을 실행 합니다.

 

프로그램 코드 안에 

 

Call session.SetConfigOption("regen_failure_handling", "resolve_mode")

 

을 삽입 하고. 프로그램 맨 마지막에 

 

Call session.SetConfigOption("regen_failure_handling", "no_resolve_mode")

 

코드를 삽입 합니다. "regen_failure_handling" 옵션은 CREO를 사용하는데 매우 중요합니다.

 

1) resolve_mode -  재생성 실패 시 resolve 모드로 들어갑니다. 여기서 사용자는 재정의(정의 편집), 억제 또는 삭제를
                                     사용하여 실패를 해결하여 모델 재생성을 계속해야 합니다.

2) no_resolve_mode - 이 모드에서는 재생 실패로 인해 사용자가 해결 모드로 들어가지 않습니다.

 

CREO 6.0 VBA API로 개발 하였습니다. CREO 7.0 부터는 프로그램 코드를 변경 해야 합니다 

Creo Parametric TOOLKIT를 제외하고 OTK C++, OTK JAVA(무료 및 라이선스 버전 모두), VB API 및 WebLink와 같은 다른 모든 Creo Customization  API는 no_resolve_mode 에서 재생성 처리를 지원하지 않습니다 . Creo Parametric 7.0 릴리스부터  regen_failure_handling 구성 옵션 이 더 이상 사용되지 않으며 사용  하지 않는 것이 좋습니다.

 

regen_failure_handling  구성 옵션 을 사용하는 동안  사용자에게 더 이상 사용되지 않는 구성 옵션을 사용하려면 allow_deprecated_config와 함께 인증 코드를 제공해야 한다는 경고 메시지가 표시됩니다.

 

 

▶ Creo 6.0 모델 

autodimensionmodel.prt.1
0.18MB


주의 사항 - MASS 값 변경)

 

치수 값이 변경 되면, Regenerate 기능을 사용 하여,  모델을 변경 합니다. MASS 값 변경을 자동으로 하려면,
config.pro > mass_property_calculate 값을 "automatic"으로 설정 해야 합니다.

 

프로그램 시작 코드에

 

Call session.SetConfigOption("mass_property_calculate", "automatic")

 

를 삽입 합니다. 프로그램 맨 마지막에 

 

Call session.SetConfigOption("mass_property_calculate", "by request")

 

코드를 삽입 합니다.

 


▶ 프로그램 소스

 

Sub modelautodim()
     On Error GoTo RunError
        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 model As IpfcModel: Set model = session.CurrentModel
        
        'config.pro 옵션
        Call session.SetConfigOption("mass_property_calculate", "automatic")
        Call session.SetConfigOption("regen_failure_handling", "resolve_mode")
                 
        'Model Path Name
        Cells(4, "C").Select: Selection.ClearContents
        Cells(4, "C") = session.GetCurrentDirectory
        
        'Model File Name
        Cells(4, "E").Select: Selection.ClearContents
        Cells(4, "E") = model.Filename
                 
        'Cells 초기화
        Range(Cells(6, "A"), Cells(Rows.count, "A")).EntireRow.Delete
                 
        'Dimension Name 정의
        Dim oModelItemOwner As IpfcModelItemOwner: Set oModelItemOwner = model
        Dim oDIM01 As IpfcModelItem
        Dim oDIM02 As IpfcModelItem
        Dim oDIM03 As IpfcModelItem
        Set oDIM01 = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, "DIM01")
        Set oDIM02 = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, "DIM02")
        Set oDIM03 = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, "DIM03")
        
        Dim oDim01value As IpfcBaseDimension: Set oDim01value = oDIM01
        Dim oDim02value As IpfcBaseDimension: Set oDim02value = oDIM02
        Dim oDim03value As IpfcBaseDimension: Set oDim03value = oDIM03
        
        
            'Model Dimension Default Value
            Cells(1, "C").Select: Selection.ClearContents
            Cells(1, "C") = oDim01value.DimValue
        
            Cells(2, "C").Select: Selection.ClearContents
            Cells(2, "C") = oDim02value.DimValue
        
            Cells(3, "C").Select: Selection.ClearContents
            Cells(3, "C") = oDim03value.DimValue
                      
        
        Dim oDimensionName As String
        Dim oDimensionValue As Double
        
        'GRAVITY Feature 개체 정의
        Dim oModelItem As IpfcModelItem
        Set oModelItem = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_FEATURE, "GRAVITY")
        Dim oParameterOwner As IpfcParameterOwner: Set oParameterOwner = oModelItem
                
        Dim i As Long, j As Long, k As Long, count As Long
        Dim dim01count As Long, dim02count As Long, dim03count As Long
         
        ' 변경 치수 마지막 값
            dim01count = 15
            dim02count = 15
            dim03count = 15
    
    
        Dim dim01step As Long, dim02step As Long, dim03step As Long

     
        ' 치수 증가 값         
            dim01step = 5
            dim02step = 5
            dim03step = 5
        
        
        'SET Regenerate
        Dim RegenInstructions As New CCpfcRegenInstructions
        Dim oInstrs As IpfcRegenInstructions: Set oInstrs = RegenInstructions.Create(True, True, Nothing)
        Dim Solid As IpfcSolid: Set Solid = model        
        
        Dim oCount As Long
        
        For i = 0 To dim01count - 1 Step dim01step
        
                oDim01value.DimValue = Range("C1").Value + i            
                
                  For j = 0 To dim02count - 1 Step dim02step

                         oDim02value.DimValue = Range("C2").Value + j
                                                               
                                   For k = 0 To dim03count - 1 Step dim03step
                
                                            oCount = oCount + 1
                                            Cells(oCount + 5, "A") = oCount
                                            
                                            'Dim01 정의
                                            Cells(oCount + 5, "B") = oDim01value.DimValue
                                            
                                            'Dim02 정의
                                            Cells(oCount + 5, "C") = oDim02value.DimValue
                                            
                                            'Dim03 정의
                                            oDim03value.DimValue = Range("C3").Value + k
                                            Cells(oCount + 5, "D") = oDim03value.DimValue
                                            
                                            Call Solid.Regenerate(oInstrs)
                                            Call Solid.Regenerate(oInstrs)
                                        
                                            'Local Parameter Name : "mass"
                                            Dim oParameter As IpfcParameter: Set oParameter = oParameterOwner.GetParam("mass")
                                            Dim oBaseParameter As IpfcBaseParameter: Set oBaseParameter = oParameter
                                            Dim oParamValue As IpfcParamValue: Set oParamValue = oBaseParameter.Value
                                            Cells(oCount + 5, "E") = oParamValue.DoubleValue
                                            
                                            'Window Repaint
                                            Dim window As pfcls.IpfcWindow
                                            Set window = session.CurrentWindow
                                            window.Repaint
                                                             
                                    Next k
                
                        Next j
            Next i
        
    Call session.SetConfigOption("mass_property_calculate", "by_request")
    Call session.SetConfigOption("regen_failure_handling", "no_resolve_mode")
    
    conn.Disconnect (2)
    
    'Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set session = Nothing
    Set model = 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

 



Sub modeldimdefault()

 On Error GoTo RunError
        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 model As IpfcModel: Set model = session.CurrentModel
                 
        'config.pro 옵션
        Call session.SetConfigOption("regen_failure_handling", "resolve_mode")
                 
         'Cells 초기화
        Range(Cells(6, "A"), Cells(Rows.count, "A")).EntireRow.Delete
                 
        'Dimension Name 정의
        Dim oModelItemOwner As IpfcModelItemOwner: Set oModelItemOwner = model
        Dim oDIM01 As IpfcModelItem
        Dim oDIM02 As IpfcModelItem
        Dim oDIM03 As IpfcModelItem
        Set oDIM01 = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, "DIM01")
        Set oDIM02 = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, "DIM02")
        Set oDIM03 = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, "DIM03")
        
        Dim oDim01value As IpfcBaseDimension: Set oDim01value = oDIM01
        Dim oDim02value As IpfcBaseDimension: Set oDim02value = oDIM02
        Dim oDim03value As IpfcBaseDimension: Set oDim03value = oDIM03
        
        oDim01value.DimValue = Range("C1")
        oDim02value.DimValue = Range("C2")
        oDim03value.DimValue = Range("C3")

        'SET Regenerate
        Dim RegenInstructions As New CCpfcRegenInstructions
        Dim oInstrs As IpfcRegenInstructions: Set oInstrs = RegenInstructions.Create(True, True, Nothing)
        Dim Solid As IpfcSolid: Set Solid = model
        
        Call Solid.Regenerate(oInstrs)
        Call Solid.Regenerate(oInstrs)
                 
        'config.pro 옵션
        Call session.SetConfigOption("regen_failure_handling", "no_resolve_mode")

conn.Disconnect (2)
    
        'Cleanup
        Set asynconn = Nothing
        Set conn = Nothing
        Set session = Nothing
        Set model = 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


[실행 엑셀 파일 ]

 

AUTO DIMENSION 03.xlsm
0.03MB



 

 

 

 

by : lionkk@idt21c.com