#3 MBD : 모델 치수 가져오기-2

□ 모델의 치수 가져오기

모델에서 선택한 치수를 가져옵니다. 치수 선택은 1개로 제한 합니다. 프로그램 사용전 반드시 모델에서 치수를 표시해야 합니다. (치수 편집 명령 실행 - edit dimensions) 

[ edit dimensions ]

모델의 치수들과 모델이름을 엑셀 파일에 저장 할수 있습니다. 모델의 치수는 "KEY"입니다. 모델에서 중복 될수 없습니다. VBA 프로그램을 이용하여 모델의 치수들 이름, 값을 변경 할수 있습니다. 엑셀의 Cell과 모델 치수 이름(KEY)을 연결 할 수 있습니다. 설계가 완료되면, 엑셀 파일에 등록된 치수는 자동으로 추적 하는 기능 개발도 가능 합니다.  

 

TOOLBOX_VBA-Select Dimension.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("Program03").Cells(2, "D") = BaseSession.GetCurrentDirectory
    Worksheets("Program03").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
    
    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("Program03").Range("B4", Worksheets("Program03").Cells(Worksheets("Program03").Rows.Count, "B").End(xlUp))
    rn = rng.Rows.Count
    
    If Selections.Count > 0 Then
        Set selectedDimension = Selections.Item(0).SelItem
        Set BaseDimension = selectedDimension
        Worksheets("Program03").Cells(rn + 4, "B") = rn
        Worksheets("Program03").Cells(rn + 4, "C") = BaseDimension.Symbol
        Worksheets("Program03").Cells(rn + 4, "D") = BaseDimension.DimType
        Worksheets("Program03").Cells(rn + 4, "E") = BaseDimension.DimValue
    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

 

순차적으로 선택한 치수의 이름 및 값이 표시 됩니다.

▷  프로그램 사용 방법

1. Edit Dimension 실행

2. Dimension Add 모드 실행

creo에서 치수를 선택 하면, 저동은 Select 선택 대화 상자메뉴는 사라집니다

 

3. 완료

 

별도의 sheet에 선택한 치수를 리스트로 만들수 있습니다. 리스트로 만든 치수는 순차적으로 계산식을 만든 Sheet로 이동 할수 있습니다.

---

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