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

활성화된 모델의 정보 (Parameter Value) #1

by ToolBOX01 2022. 9. 19.
반응형

■ 기능 소개

[ 엑셀 화면 ]

1. New 버튼 클릭

    1) 파일 위치 : 현재 활성화 된 모델의 폴더 위치를 표시 합니다

    2) 파일 이름 : 현재 활성화 된 모델의  이름을 표시 합니다.

  3) ISOVIEW : 현재 활성화된 모델의 "ISOVIEW" 이름의 View로 이동후, Creo 파일 이름과 동일한 JPG 이미지를
                           삽입 합니다. JPG 이미지는 C:\PTC\IMAGES 폴더에 저장 됩니다.

    4) PART_NO: Paramert 이름 "PART_NO"의 값 표시 합니다. 반드시 모델에 "PART_NO" 값이 있어야 합니다.

    5) PART_NAME: Paramert 이름 "PART_NAME"의 값 표시 합니다. 반드시 모델에 "PART_NAME" 값이 있어야 합니다.

    6) MATERIAL_NAME: Paramert 이름 "MATERIAL_NAME"의 값 표시 합니다. 반드시 모델에 "MATERIAL_NAME"
                            값이 있
어야 합니다. Creo에서 MATERIAL을 변경 하면 자동으로 모델의 재질 이름은  변경 됩니다. (읽기 전용)

    7) WEIGHT :  MASS Feature의 로컬 매개변수 "MASS"값을 표시 합니다. 수정을 할수 없습니다. (읽기 전용)

 

2. Paramerer Save

    변경된 "PART_NO", "PART_NAME" 값을 Creo 모델에 저장 합니다

 

3. Material Change

    Mapkey를 호출하여 Creo에서 재질 파일을 선택 합니다.

 

4. Initialization 

    Cell "5A" 이하를 모두 삭제 합니다.  또한 Cell " 4C"도 삭제 합니다.

 

■ Test 모델 

[ 재질 지정 ]
[ 재질 파일 안의 사용자 정의 Parameter ]

 

[ 관계식 설정]
autodimensionmodel_v2.prt.5
0.18MB

 

 

▶ NEW 버튼 소스 코드

 

Sub Newmodel()
     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") = session.GetCurrentDirectory
        
        'Model File Name
        Cells(6, "B") = model.Filename
        
       '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)
                 
        '현재 모델의Parameter들 모으기
        Dim oPowner As pfcls.IpfcParameterOwner: Set oPowner = model
        Dim oParams As IpfcParameters: Set oParams = oPowner.ListParams()
                       
        Dim oParam As IpfcBaseParameter
        Dim oParamValue As IpfcParamValue
        Dim oParamName As IpfcNamedModelItem
                
        Dim i As Long
        For i = 0 To oParams.count - 1
        
            Set oParam = oParams(i)
            Set oParamValue = oParam.Value
            Set oParamName = oParam
           
            If oParamName.name = "PART_NO" Then
                Cells(6, "D") = oParamValue.StringValue
                    
                ElseIf oParamName.name = "PART_NAME" Then
                    Cells(6, "E") = oParamValue.StringValue
                
                    ElseIf oParamName.name = "MASS_NAME" Then
                        Cells(6, "F") = oParamValue.StringValue
                             
             End If
            
        Next i     
            
       'GRAVITY Feature 개체 정의
       Dim oModelItemOwner As IpfcModelItemOwner: Set oModelItemOwner = model
       Dim oModelItem As IpfcModelItem
       Set oModelItem = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_FEATURE, "GRAVITY")
       Dim oParameterOwner As IpfcParameterOwner: Set oParameterOwner = oModelItem
              
       'Local Parameter Name : "mass"
       Dim oParametermass As IpfcParameter: Set oParametermass = oParameterOwner.GetParam("mass")
       Dim oBaseParametermass As IpfcBaseParameter: Set oBaseParametermass = oParametermass
       Dim oParamValuemass As IpfcParamValue: Set oParamValuemass = oBaseParametermass.Value
                        
       Cells(6, "G") = oParamValuemass.DoubleValue


       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

 

initialzation 버튼 소스 코드


Sub modelinitialzation()

            'Cells clear
            Cells(4, "C").Select: Selection.ClearContents
            Range(Cells(6, "A"), Cells(Rows.count, "A")).EntireRow.Delete

End Sub