How to get the dimensions of a feature by Creo Parametric VB API?

Feature 별로 치수 값을 표시 하는 방법  - Get dimensions by feature

 

 

IpfcFeature.ListSubItems()를 사용 합니다

 

Use IpfcFeature.ListSubItems() with EpfcModelItemType.EpfcITEM_DIMENSION as the input argument to get the dimensions of a feature.

 

프로그램 실행

 

 

 

실행 동영상

 

 

 

Source code

 

Sub dim_name_value()
        Dim asynconn As New pfcls.CCpfcAsyncConnection
        Dim conn As pfcls.IpfcAsyncConnection
        Dim session As pfcls.IpfcBaseSession
    
    On Error GoTo RunError
        Set conn = asynconn.Connect("", "", ".", 5)
        Set session = conn.session
    
        Dim model As IpfcModel
        Set model = session.CurrentModel
        
        Cells(4, "c") = session.GetCurrentDirectory
        Cells(5, "c") = model.Filename

        
        'Cells 초기화
        Range(Cells(7, "A"), Cells(Rows.Count, "A")).EntireRow.Delete
        
        
        Dim Solid As IpfcSolid
        Set Solid = model
        Dim ModelItemOwner As IpfcModelItemOwner
        Set ModelItemOwner = session.CurrentModel
        Dim Featureitems As IpfcModelItems
        Set Featureitems = ModelItemOwner.ListItems(EpfcModelItemType.EpfcITEM_FEATURE)
                  
        Dim Feature As IpfcFeature
        Dim Dimensionitems As IpfcModelItems
        Dim Dimension As IpfcBaseDimension
        
        'Dimensions of Feature Count Number
        Dim DimensionitemCount As Integer, CellsCount As Integer
        CellsCount = 0
          
        For i = 0 To Featureitems.Count - 1
                Set Feature = Featureitems(i)
                Set Dimensionitems = Feature.ListSubItems(EpfcModelItemType.EpfcITEM_DIMENSION)
               
                If Dimensionitems.Count = 0 Then
                    Cells(i + CellsCount + 7, "a") = i + 1
                    Cells(i + CellsCount + 7, "b") = Feature.FeatTypeName
                    Cells(i + CellsCount + 7, "c") = Feature.Number
                                        
                Else
                
                    Cells(i + 7 + CellsCount, "a") = i + 1
                    Cells(i + 7 + CellsCount, "b") = Feature.FeatTypeName
                    Cells(i + 7 + CellsCount, "c") = Feature.Number
                    
                           For j = 0 To Dimensionitems.Count - 1
                                 Set Dimension = Dimensionitems(j)
                                 Cells(i + j + 7 + CellsCount, "d") = Dimension.Symbol
                                 Cells(i + j + 7 + CellsCount, "e") = Dimension.DimValue
                                 Cells(i + j + 7 + CellsCount, "f") = Dimension.DimType
                            Next j
                                      
                End If
                
                CellsCount = Dimensionitems.Count + CellsCount
        Next i


    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

 

feature dim name value v2.xlsm

0.04MB

 

 

주의> patten 적용불가 합니다. Creo에 버그가 있습니다.

 

Patten is not applicable. There is a bug in Creo.

 

 

creo에서 두번째 패턴의 맨끝 dimension Symbol을 표시 주지 않습니다. Feature가 patten 인지 인식하는 코드가 필요 하며,  patten 이면 첫번째 Feautre의 값만 표시하는 코드가 추가되어야 합니다.

 

 

Business inquiries : lionkk@idt21c.com

---