선택된 Feature에 Dimension이 있는 경우 가져오기

□ 모델의 선택한 Feature의 치수 이름 및 값을 가져오는 프로그램

1개의 Feaure만 선택 됩니다. Sheet 이름이 "Program08"로 정의 되어 있어야 합니다. 마우스,로 Feature를 선택 하면 치수 이름 및 값이 표시됩니다. 만일 값이 없으면 스크립트 오류가 발생 합니다.  오류 처리 코드는 넣지 않았습니다.

번호순서를 순차적으로 하는 코드는 완료되지 않았습니다. 

[ 프로그램 UI ]

Dim SelectionOptions As New pfcls.CCpfcSelectionOptions
Dim Selopt As pfcls.IpfcSelectionOptions
Dim Selections As pfcls.IpfcSelections

Set Selopt = SelectionOptions.Create("feature")
Selopt.MaxNumSels = 1
Set Selections = BaseSession.Select(Selopt, Nothing)

" Set Selopt = `~", " Selopt.MaxNumSels = ~"은 모델에서 선택을 위한 옵션을 정의 합니다.
Creo 화면에서 "feature"만 선택 됩니다. 주의 반드시 소문자만 입력 해야 합니다. 대문자 입력시 동작 하지 않습니다. "Selopt.MaxNumSels = 1"는 1개만 선택 하라는 옵션 입니다

TOOLBOX_VBA_sheet08.xlsm

0.03MB

▷  VBA 코드

Option Explicit

Sub Select_Feature_LIST()
    On Error GoTo RunError
    
    Application.EnableEvents = False
    
    '// Check if "Program08" worksheet exists
    If Not WorksheetExists("Program08") Then
        MsgBox "Worksheet 'Program08' not found.", vbExclamation, "Error"
        Exit Sub
    End If
    
    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection
    
    '// Check Creo Connect
    Set conn = asynconn.Connect("", "", ".", 5)
    
    If conn Is Nothing Then
        MsgBox "An error occurred while starting a 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("Program08").Cells(2, "E") = BaseSession.GetCurrentDirectory
    Worksheets("Program08").Cells(3, "E") = model.Filename
    
    Dim Selections As pfcls.IpfcSelections
    Dim SelectionOptions As New pfcls.CCpfcSelectionOptions
    Dim Selopt As pfcls.IpfcSelectionOptions
    Dim Feature As pfcls.IpfcFeature
    Dim Dimensionitems As pfcls.IpfcModelItems
    Dim Dimension As pfcls.IpfcBaseDimension
    Dim rng As Range
    Dim lastRow As Long ' Remember the last row number from the previous run
    Dim nextRow As Long ' Track the next available row
    Dim i As Integer
    
    '// Find the last row number from the previous run
    lastRow = Worksheets("Program08").Cells(Worksheets("Program08").Rows.Count, "B").End(xlUp).Row
    
    '// Find the next available row
    nextRow = lastRow + 1
    
    Set rng = Worksheets("Program08").Range("B" & nextRow).Resize(1, 3) ' Initialize range
    
     
    
    '// Model Feature Select
    Set Selopt = SelectionOptions.Create("feature")
    Selopt.MaxNumSels = 1
    Set Selections = BaseSession.Select(Selopt, Nothing)
    
    If Selections.Count > 0 Then
        Set Feature = Selections.item(0).SelItem
        Set Dimensionitems = Feature.ListSubItems(EpfcModelItemType.EpfcITEM_DIMENSION)
        
        ' Resize the range based on the number of items
        Set rng = rng.Resize(Dimensionitems.Count, 3)
        
        For i = 0 To Dimensionitems.Count - 1
            Set Dimension = Dimensionitems.item(i)
            
            '// Set the number
            rng.Cells(i + 1, 1).Value = lastRow + 1 + i
            '// Dimension Name
            rng.Cells(i + 1, 2).Value = Dimension.Symbol
            rng.Cells(i + 1, 3).Value = Dimension.DimValue
        Next i
    End If
    
    MsgBox "Displayed Feature Names", 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: An error occurred." & vbCrLf & _
               "Error No: " & CStr(Err.Number) & vbCrLf & _
               "Error Description: " & Err.Description & vbCrLf & _
               "Error Source: " & Err.Source, vbCritical, "Error"
        If Not conn Is Nothing Then
            If conn.IsRunning Then
                conn.Disconnect (2)
            End If
        End If
    End If
End Sub

Function WorksheetExists(shtName As String) As Boolean
    On Error Resume Next
    WorksheetExists = Not Worksheets(shtName) Is Nothing
    On Error GoTo 0
End Function

 

자주 사용 가능한 코드 입니다. 선택돤 객체의 타입을 Parameter 또는 Dimension으로 정의 할수 있습니다
Feauture가 가지고 있는  치수 및 Parameter를  가져올수 있습니다. 치수 이름을 자동으로 변경 할수 있습니다.

Dim Selections As pfcls.IpfcSelections
Dim Feature As pfcls.IpfcFeature
Dim Dimensionitems As pfcls.IpfcModelItems
Dim Dimension As pfcls.IpfcBaseDimension

Set Feature = Selections.item(0).SelItem
Set Dimensionitems = Feature.ListSubItems(EpfcModelItemType.EpfcITEM_DIMENSION)
Set Dimension = Dimensionitems.item(i)

모델을 Open 하고, 설계 검증, 생산 관디, 제조에 사용될 Feature 또는 치수, Parameter를 선택 또는 표준화를 하면 설계자가 만든 모델의 치수 값의 변경 내용을 검색 할수 있습니다. 설계 표준화(프로세스 포함)를 하면, 자동화를 할수 있는 방법을 찾을수 있습니다. 이것은 데이터 베이스로 구성 할수 있습니다. 제품 설계의 프로세스를 정의 하고 > 모델의 구성 부품들을 구성 하고 > 부품의 모델링 순서를 표준화 하십시요. 설계 자동화가 가능한 Template 모델을 구성 할수 있습니다

이것의 치수 값, Feature들을 조정할수 있는 VBA 프로그램을 만들어 사용 하십시요. 물론 데이터 베이스에 등록된 치수 값을 사용하십시요. 위 코드는 ChatGTP를 활용하여 개발 하였습니다. 누군가는 AI를 이용하여 제품 설계 자체를 자동화 할것 입니다. 

---

Cell에 이미 있는 데이터 다음에 새로운 데이터를 추가할 범위를 동적으로 설정하는 코드 입니다

Dim rng As Range
Set rng = Worksheets("Program08").Range("B4", Worksheets("Program08").Cells(Worksheets("Program08").Rows.Count, "B").End(xlUp).offset(1, 0))

 

엑셀 VBA에서 범위를 동적으로 조정하여 사용할 데이터의 위치를 지정합니다.

1. `Worksheets("Program08")`: 
이 부분은 "Program08" 워크시트를 나타냅니다. `Worksheets` 함수를 사용하여 워크시트의 참조를 얻습니다.

2. `.Range("B4", Worksheets("Program08").Cells(Worksheets("Program08").Rows.Count, "B").End(xlUp).Offset(1, 0))`: 
     이 부분은 범위를 설정하는 부분입니다. 여기서 설명을 분해해보겠습니다.

   - `.Range("B4")`: 범위의 시작 셀을 "B4"로 설정합니다.
   
   - `Worksheets("Program08").Cells(Worksheets("Program08").Rows.Count, "B").End(xlUp)`: 이 부분은 "B" 열에서 
      가장 아래에 있는 비어 있지 않은 셀을 찾습니다. `Worksheets("Program08").Rows.Count`는 "Program08" 워크시트의
      행(↓) 수를 반환하고, `End(xlUp)`은 해당 열의 맨 아래에서 위로 이동하여 비어 있지 않은 셀을 찾습니다.

   - `.Offset(1, 0)`: 찾은 셀에서 한 행(↓) 아래로 이동합니다. 이렇게 하면 새로운 데이터가 추가될 위치가 됩니다.

데이터가 계속해서 늘어날 때도 항상 마지막 행 다음에 데이터를 추가할 수 있도록 하는 유용한 방법입니다.

---

▷ 참고 사이트

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

---

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