모델이 가지고 있는 치수 값을 가지고 오기 - 두번째

IpfcModelItemOwner.ListItems(EpfcModelItemType.EpfcITEM_DIMENSION) 코드로 Creo 모델이 가지고 있는 치수 값을 표시 합니다. IpfcBaseDimension.DimValue를 이용하여 값을 가져 올수 있습니다. 

Program Download

ToolBOX VBA 01.xlsm

0.07MB

 

 

IpfcBaseDimension.DimType 은 아래와 같이 "숫자"로 표시됩니다.

• DIM_LINEAR  : "0"
• DIM_RADIAL : "1"
• DIM_DIAMETER :  "2"
• DIM_ANGULAR : "3"

 

IpfcBaseDimension. DimValue은 치수의 값을 가져옵니다.

IpfcDimension. Tolerance,   IpfcDimTolPlusMinus,    IpfcDimTolSymmetric는 공차 값을 가져 옵니다.

■ 코드

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

    Application.EnableEvents = False
    
    '//////////////////////////////////////////////////////////////////////////////////////////////////////
    '// Creo Connect Check
    '//////////////////////////////////////////////////////////////////////////////////////////////////////
    On Error Resume Next
    Set conn = asynconn.Connect("", "", ".", 5)
    
        If conn Is Nothing Then
        
           MsgBox "Error occurred while starting new Creo Parametric Session!", vbInformation, "www.idt21c.com"
           Exit Sub
           
        End If
     '//////////////////////////////////////////////////////////////////////////////////////////////////////
    
    Set oSession = conn.Session
    
    '// Current Model
    Set oModel = oSession.CurrentModel
    Set oSolid = oModel


End Sub
Sub Dim_3d()
 
    Call Creo_Connect
    
    Cells(4, "C") = oModel.Filename
    
    '// Creo Parameter variable
    
    Dim oModelowner As IpfcModelItemOwner
    Set oModelowner = oModel
    Dim oModelitems As IpfcModelItems
    Set oModelitems = oModelowner.ListItems(EpfcModelItemType.EpfcITEM_DIMENSION)
    
    
    Dim i As Integer
    Dim oModelItem As IpfcModelItem
    Dim oBaseDimension As IpfcBaseDimension
    Dim oDimension As IpfcDimension
    Dim oDimTolerance As IpfcDimTolerance
    Dim oDimTolPlusMinus As IpfcDimTolPlusMinus
    Dim oDimTolSymmetric As IpfcDimTolSymmetric
    
        
    For i = 0 To oModelitems.Count - 1
    
        Set oBaseDimension = oModelitems.Item(i)
        Set oDimension = oBaseDimension
        Set oDimTolerance = oDimension.Tolerance
         
        Cells(i + 6, "A") = i + 1
        Cells(i + 6, "B") = oBaseDimension.Symbol
        Cells(i + 6, "C") = oBaseDimension.DimValue
        
        '// Dimension Type
        
        If oBaseDimension.DimType = 0 Then
        
            Cells(i + 6, "D") = "Linear"
            
        ElseIf oBaseDimension.DimType = 1 Then
        
            Cells(i + 6, "D") = "Radial"
            
        ElseIf oBaseDimension.DimType = 2 Then
        
            Cells(i + 6, "D") = "Diameter"
            
        Else
        
            Cells(i + 6, "D") = "Angular"
            
        End If


        '// Dimension Tolerance Type & Value
        
        If oDimTolerance Is Nothing Then
        
                Cells(i + 6, "E") = "Nominal"
                
            ElseIf oDimTolerance.Type = 0 Then
                
                Cells(i + 6, "E") = "Limits"
                                
            ElseIf oDimTolerance.Type = 1 Then
             
                Cells(i + 6, "E") = "PLUS_MINUS"
                Cells(i + 6, "E").Font.Color = vbBlue
                
                Set oDimTolPlusMinus = oDimTolerance
                
                Cells(i + 6, "F") = oDimTolPlusMinus.Plus
                Cells(i + 6, "F").Font.Color = vbBlue
                Cells(i + 6, "G") = oDimTolPlusMinus.Minus * -1
                Cells(i + 6, "G").Font.Color = vbBlue
                
            ElseIf oDimTolerance.Type = 2 Then
            
               Cells(i + 6, "E") = "SYMMETRIC"
               Cells(i + 6, "E").Font.Color = vbRed
               
               Set oDimTolSymmetric = oDimTolerance
               
               Cells(i + 6, "F") = oDimTolSymmetric.Value
               Cells(i + 6, "F").Font.Color = vbRed
               Cells(i + 6, "G") = oDimTolSymmetric.Value * -1
               Cells(i + 6, "G").Font.Color = vbRed
                         
               
            Else
             
               Cells(i + 6, "E") = oDimTolerance.Type
           
        End If

    Next i
 
End Sub

 

by lionkk@idt21c.com

 

 

모든 치수 이름과 값 표시하기