#5 설계 공차 분석 - 도면의 치수 및 공차 값 가져오기

□ Get selected drawing dimension values

도면의 치수를 선택 하여, 치수 값과 공차 값을 가져오는 프로그램 입니다. 

주의) 
ISO 스탠더드 테이블을 적용 하면, 치수 공차 타입 및 값은 가져올수 없습니다. General. Broken Edge를 선택 하면 공차 값을 가져 올수 없습니다

▷ 사용 방법

Dimension Add 버튼을 클릭하고, 도면에서 치수 를 선택하면 됩니다.

 

TOOLBOX_VBA Drawing Dimension List.xlsm

0.03MB

 

▷ VBA 코드

Option Explicit
Sub Select_2D_Dimension()
    On Error GoTo RunError
    
    Application.EnableEvents = False
    
    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection
    
    '// Creo Connect Check
    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

    Dim BaseSession As pfcls.IpfcBaseSession
    Dim Model As pfcls.IpfcModel

    Set BaseSession = conn.Session
    Set Model = BaseSession.CurrentModel
    
    '// Current Model Information
    Worksheets("Program05").Cells(2, "D") = BaseSession.GetCurrentDirectory
    Worksheets("Program05").Cells(3, "D") = Model.Filename
    
    Dim selectedDimension As pfcls.IpfcModelItem
    Dim Selections As pfcls.IpfcSelections
    Dim SelectionOptions As New pfcls.CCpfcSelectionOptions
    Dim Selopt As pfcls.IpfcSelectionOptions
    Dim BaseDimension As pfcls.IpfcBaseDimension
    Dim Dimension2D As IpfcDimension2D
    Dim DimTolerance As IpfcDimTolerance
    Dim DimTolPlusMinus As IpfcDimTolPlusMinus
    Dim DimTolSymmetric As IpfcDimTolSymmetric
    
    '// Drawing Dimension Select
    Set Selopt = SelectionOptions.Create("Dimension")
    Selopt.MaxNumSels = 1
    Set Selections = BaseSession.Select(Selopt, Nothing)
    
    Dim rng As Range
    Dim rn As Long
    
    Set rng = Worksheets("Program05").Range("B4", Worksheets("Program05").Cells(Worksheets("Program05").Rows.Count, "B").End(xlUp))
    rn = rng.Rows.Count
    
    If Selections.Count > 0 Then
        Set selectedDimension = Selections.Item(0).SelItem
        Set BaseDimension = selectedDimension
        Set Dimension2D = BaseDimension
        Set DimTolerance = Dimension2D.GetTolerance
         
        Worksheets("Program05").Cells(rn + 4, "B") = rn
        
        '// Dimension Name
        Worksheets("Program05").Cells(rn + 4, "C") = BaseDimension.Symbol
        
        
        '// Dimension Type
        If BaseDimension.DimType = 0 Then
                Worksheets("Program05").Cells(rn + 4, "D") = "Linear"
            ElseIf BaseDimension.DimType = 1 Then
                Worksheets("Program05").Cells(rn + 4, "D") = "Radial"
            ElseIf BaseDimension.DimType = 2 Then
                Worksheets("Program05").Cells(rn + 4, "D") = "Diameter"
            Else
                Worksheets("Program05").Cells(rn + 4, "D") = "Angular"
        End If
        
        '// Dimension Value
        Worksheets("Program05").Cells(rn + 4, "E") = BaseDimension.DimValue
        
        
        '// Dimension Tolerance Type & Value
         If DimTolerance.Type = 0 Then
                Worksheets("Program05").Cells(rn + 4, "F") = "Limits"
            
            ElseIf DimTolerance.Type = 1 Then
                Worksheets("Program05").Cells(rn + 4, "F") = "PLUS_MINUS"
                Worksheets("Program05").Cells(rn + 4, "F").Font.Color = vbBlue
                
                Set DimTolPlusMinus = DimTolerance
                
                Worksheets("Program05").Cells(rn + 4, "G") = DimTolPlusMinus.Plus
                Worksheets("Program05").Cells(rn + 4, "G").Font.Color = vbBlue
                Worksheets("Program05").Cells(rn + 4, "H") = DimTolPlusMinus.Minus * -1
                Worksheets("Program05").Cells(rn + 4, "H").Font.Color = vbBlue
                
            ElseIf DimTolerance.Type = 2 Then
            
               Worksheets("Program05").Cells(rn + 4, "F") = "SYMMETRIC"
               Worksheets("Program05").Cells(rn + 4, "F").Font.Color = vbRed
               
               Set DimTolSymmetric = DimTolerance
               
               Worksheets("Program05").Cells(rn + 4, "G") = DimTolSymmetric.Value
               Worksheets("Program05").Cells(rn + 4, "G").Font.Color = vbRed
               Worksheets("Program05").Cells(rn + 4, "H") = DimTolSymmetric.Value * -1
               Worksheets("Program05").Cells(rn + 4, "H").Font.Color = vbRed
                          
            Else
             
               Worksheets("Program05").Cells(rn + 4, "F") = "Nominal"
           
        End If
    End If
    
    MsgBox "치수를 입력하였습니다", vbInformation, "ToolBOX VBA"
    
    conn.Disconnect (2)
    
    '// Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set BaseSession = Nothing
    Set Model = Nothing

    Exit Sub

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