#3 MBD : 모델 치수 및 공차 가져오기-3

□ 모델의 치수 및 공차 가져오기

모델에서 치수를 선택하여 치수 및 공차를 가져오는 프로그램 입니다. 공차는 +/- 와 대칭의 값을 표시 합니다.

Creo 모델

엑셀

 

TOOLBOX_VBA-Dimension tolerance.xlsm

0.03MB

 

▷ VBA 코드

Option Explicit
Sub Select_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
    Dim Solid As pfcls.IpfcSolid
    
    Set BaseSession = conn.Session
    Set Model = BaseSession.CurrentModel
    Set Solid = Model
    
    '// Current Model Information
    Worksheets("Program04").Cells(2, "D") = BaseSession.GetCurrentDirectory
    Worksheets("Program04").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 Dimension As IpfcDimension
    Dim DimTolerance As IpfcDimTolerance
    Dim DimTolPlusMinus As IpfcDimTolPlusMinus
    Dim DimTolSymmetric As IpfcDimTolSymmetric
    
    '// Model 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("Program04").Range("B4", Worksheets("Program04").Cells(Worksheets("Program04").Rows.Count, "B").End(xlUp))
    rn = rng.Rows.Count
    
    If Selections.Count > 0 Then
        Set selectedDimension = Selections.Item(0).SelItem
        Set BaseDimension = selectedDimension
        Set Dimension = BaseDimension
        Set DimTolerance = Dimension.Tolerance
         
        Worksheets("Program04").Cells(rn + 4, "B") = rn
        
        '// Dimension Name
        Worksheets("Program04").Cells(rn + 4, "C") = BaseDimension.Symbol
        
        '// Dimension Type
        If BaseDimension.DimType = 0 Then
                Worksheets("Program04").Cells(rn + 4, "D") = "Linear"
            ElseIf BaseDimension.DimType = 1 Then
                Worksheets("Program04").Cells(rn + 4, "D") = "Radial"
            ElseIf BaseDimension.DimType = 2 Then
                Worksheets("Program04").Cells(rn + 4, "D") = "Diameter"
            Else
                Worksheets("Program04").Cells(rn + 4, "D") = "Angular"
        End If
        
        '// Dimension Value
        Worksheets("Program04").Cells(rn + 4, "E") = BaseDimension.DimValue
        
        
        '// Dimension Tolerance Type & Value
         If DimTolerance Is Nothing Then
                Worksheets("Program04").Cells(rn + 4, "F") = "Nominal"
            
            ElseIf DimTolerance.Type = 0 Then
                Worksheets("Program04").Cells(rn + 4, "F") = "Limits"
            
            ElseIf DimTolerance.Type = 1 Then
                Worksheets("Program04").Cells(rn + 4, "F") = "PLUS_MINUS"
                Worksheets("Program04").Cells(rn + 4, "F").Font.Color = vbBlue
                
                Set DimTolPlusMinus = DimTolerance
                
                Worksheets("Program04").Cells(rn + 4, "G") = DimTolPlusMinus.Plus
                Worksheets("Program04").Cells(rn + 4, "G").Font.Color = vbBlue
                Worksheets("Program04").Cells(rn + 4, "H") = DimTolPlusMinus.Minus * -1
                Worksheets("Program04").Cells(rn + 4, "H").Font.Color = vbBlue
                
            ElseIf DimTolerance.Type = 2 Then
            
               Worksheets("Program04").Cells(rn + 4, "F") = "SYMMETRIC"
               Worksheets("Program04").Cells(rn + 4, "F").Font.Color = vbRed
               
               Set DimTolSymmetric = DimTolerance
               
               Worksheets("Program04").Cells(rn + 4, "G") = DimTolSymmetric.Value
               Worksheets("Program04").Cells(rn + 4, "G").Font.Color = vbRed
               Worksheets("Program04").Cells(rn + 4, "H") = DimTolSymmetric.Value * -1
               Worksheets("Program04").Cells(rn + 4, "H").Font.Color = vbRed
                                 
            Else      
               Worksheets("Program04").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

모델의 치수를 선택 합니다. 선택된 치수의 공차 값을 표시 합니다.

---

영업문의 : lionkk@idt21c.com
카카오 채널 : http://pf.kakao.com/_fItAxb