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

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

by ToolBOX01 2022. 9. 15.
반응형

모델의 치수 값을 자동으로 변경 하여, 무게 측정 Feature의 Mass 값 가져오는 프로그램 입니다.

치수 이름 "DIM01"을 시작 값 10.5로 변경 하고, 10씩 증가 시켜 1000이 될때까지 모델을 변경 합니다

그때 자동으로 변경되는 측정 Feature의 로컬 매개 변수 값을 가져 오는 프로그램 입니다.

 

치수 이름은 모델에서 유니크 (unique)합니다.

 

 

▶ 소스 코드

 

Sub Feature_LIST2()
     On Error GoTo RunError

      ' CurrentModel 연결
        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
        
        'Model Path Name
        Cells(1, "c").Select: Selection.ClearContents
        Cells(1, "c") = session.GetCurrentDirectory
        
        'Model File Name
        Cells(1, "D").Select: Selection.ClearContents
        Cells(1, "D") = model.Filename
               
        '기존 Cells 의 내용 초기화
        Range(Cells(3, "A"), Cells(Rows.Count, "A")).EntireRow.Delete
        
        
        'Creo Dimension 개체 정의

        ' IpfcModelItem 변수에 모델에 정의된 "DIM01", "DIM02", "DIM03" 개체 가져오기
        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
                      
        'Dimension 개체에서 이름 및 값 가져오는 변수 정의
        Dim oDimensionName As String
        Dim oDimensionValue As Double
        Dim i As Double, j As Integer, k As Integer: k = 0
        
        '모델의 "GRAVITY" Feature 개체의 변수 (변수 이름 : oModelItem) 정의
        Dim oModelItem As IpfcModelItem
        Set oModelItem = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_FEATURE, "GRAVITY")
          

       ' "GRAVITY" Feature 개체의에서 로컬 매개변수 개체  가져오기
        Dim oParameterOwner As IpfcParameterOwner: Set oParameterOwner = oModelItem
       

        ' 프로그램으로 치수 값 변경을 하려면 반드시 Config,pro 옵션을 추가 해야한다,
        '  "resolve_mode" 설정이 안되면 치수 값 변경이 불가능 하다        
         Call session.SetConfigOption("regen_failure_handling", "resolve_mode")
        

       ' 치수 값이 변경되어 자동으로 mass 값을 변경 하려면 반드시 "automatic"으로 설정 해야 한다.

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

 


        For i = 0 To 1000 Step 10
            k = k + 1
            oDim01value.DimValue = 10.5 + i     " 모델의 초기 값

            Cells(k + 2, 1) = k                              " 번호 항목
            Cells(k + 2, 2) = 10.5 + i                    " DIM01 항목
               
            'SET Regenerate
            Dim RegenInstructions As New CCpfcRegenInstructions
            Dim Instrs As IpfcRegenInstructions: Set Instrs = RegenInstructions.Create(True, True, Nothing)           
            Dim Solid As IpfcSolid: Set Solid = model
            Call Solid.Regenerate(ForceRegen)
            Call Solid.Regenerate(ForceRegen)    " 관계식 값 변경을 위해 실행
            
            
            '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
            'Local Parameter  Value Type : DoubleValue
            Cells(k + 2, 5) = oParamValue.DoubleValue
            
                         
            'Window Repaint
            Dim window As pfcls.IpfcWindow
            Set window = session.CurrentWindow
            window.Repaint
            
            
        Next i
   

        'CREO Config.pro 초기화
         Call session.SetConfigOption("regen_failure_handling", "no_resolve_mode")
         Call session.SetConfigOption("mass_property_calculate", "by_request") 
    

 

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

 

 

▶ 프로그램 실행

 

 

By : lionkk@idt21c.com