본문 바로가기
  • Welcome!
VBA For Creo

Creo File 정보 얻기 Ver 0.2

by ToolBOX01 2022. 10. 4.
반응형

현재 활성화된 3D모델의  Parameter 값을 얻고, 입력한  Parameter 값을 Creo로 보내는 기능 입니다. 만일 모델에 

Parameter가 없으면, 자동으로 모델에 저장 됩니다. MS 데이터 베이스 액세스와 연계하는 프로그램 입니다.

Part List 프로그램과 연계 예정 입니다. Part List에서 비어있는 Parameter 값은 Creo 파일을 Open 하고,

아래 프로그램으로 입력을 할 수 있습니다. 

 

주의 >

Family Table 파일은 사용 할수 없습니다. 

 

 

 

1. 새로 고침

    - 현재 활성화된 Creo 파일 이름을 표시 합니다

    - Creo 파일이 위치한 폴더 이름을 표시 합니다

    - 지정한 Parameter 값을 표시합니다

 

2. Image

   - Creo 파일을 "jpg" 형식으로 저장 됩니다. C:\idt\images에 저장 됩니다

 

3. Parameter

   - 입력한 Parameter 값을 Creo 파일에 저장 합니다

   - "Stamp_Number"는 VBA API가 발행하는 고유 번호 입니다

   - "Class"는 제품 구분자 입니다.

 

4. Data Base

   - Creo  파일 이름, 폴더 이름, Parameter 값을 저장 합니다

 


1. 새로 고침 코드

매개변수 이름과 변수 타입을 미리 정의 해야 합니다. 

'현재 모델의Parameter들 모으기
        Dim rng As Range
        Set rng = Range("B6", Cells(Rows.Count, "B").End(xlUp))
        
        Dim oPowner As pfcls.IpfcParameterOwner: Set oPowner = oModel
        Dim oParam As IpfcBaseParameter
        Dim oParamValue As IpfcParamValue
        Dim oParamName As IpfcNamedModelItem
                
        Dim i As Long
        
        For i = 0 To rng.Count - 1
    
            Set oParam = oPowner.GetParam(Cells(i + 6, "B"))
                
                If Not oParam Is Nothing Then
                    Set oParamValue = oParam.Value
                    Set oParamName = oParam
                    
                    If oParamName.Name = "MASS" Or oParamName.Name = "SUPRESS" Or oParamName.Name = "FEATURE_COUNT" Or oParamName.Name = "FILE_SIZE" _
                       Or oParamName.Name = "X_Y_Z" Or oParamName.Name = "STAMP_NUMBER" Then
                            Cells(i + 6, "C") = oParamValue.DoubleValue
                        Else
                            Cells(i + 6, "C") = oParamValue.StringValue
                    
                    End If
                    
                End If
            
        Next i

 

2. 이미지

Background Color 흰색으로 변경 - Mapkey 사용

Datum Display 변경 - config.pro 변경

    'Back Ground Color White
    Dim BackgroundWhitemacro As String
    BackgroundWhitemacro = "al_screen_cap @MAPKEY_LABEL스크린 샷을 찍기위해서 흰배경으로 변경;\mapkey(continued) ~ Select `main_dlg_cur` `appl_casc`;~ Close `main_dlg_cur` `appl_casc`;\mapkey(continued) ~ Command `ProCmdRibbonOptionsDlg` ;\mapkey(continued) ~ Select `ribbon_options_dialog` `PageSwitcherPageList` 1 `colors_layouts`;\mapkey(continued) ~ Open `ribbon_options_dialog` `colors_layouts.Color_scheme_optMenu`;\mapkey(continued) ~ Close `ribbon_options_dialog` `colors_layouts.Color_scheme_optMenu`;\mapkey(continued) ~ Select `ribbon_options_dialog` `colors_layouts.Color_scheme_optMenu` 1 `2`;\mapkey(continued) ~ Activate `ribbon_options_dialog` `OkPshBtn`;\mapkey(continued) ~ Command `ProCmdViewSpinCntr`  0;nCntr`  0;"
    session.RunMacro (BackgroundWhitemacro)
            
    'Datum And Model Shading config.pro 옵션
    Call session.SetConfigOption("display_planes", "no")
    Call session.SetConfigOption("display_Axes", "no")
    Call session.SetConfigOption("display_annotations", "no")
    Call session.SetConfigOption("display_coord_sys", "no")
    Call session.SetConfigOption("display", "shadewithedges")

 

이미지 파일 엑셀 Sheet에 변경 

 'jpg image Insert
    Name = oJpgfilename
    str2 = "C:\idt\images\" & oJpgfilename
    ret = Dir(str2)
    
    If ret <> "" Then
        Set Pic = ActiveSheet.Pictures.Insert(str2)
        Set Imagecell = Cells(2, "A")
        
        Rows("2").RowHeight = 100
        
        With Pic
            .ShapeRange.LockAspectRatio = msoFalse
            .Left = Imagecell.Left + 1
            .Top = Imagecell.Top + 1
            .Width = Imagecell.Width - 1
            .Height = Imagecell.Height - 1
        End With
    End If

 

 

 

[ 프로그램 동작 ]

 

file info ver02.xlsm
0.04MB

 

 

액세스 데이터 연결과 파라메터 값 (Part_no, Part_name, Designer, Class)을 입력 하면 Creo 모델로 보내는 기능은 추가 하지 않았습니다. 아래 내용을 참고 하여 기능을 만들수 있습니다.

 

 

엑셀의 Parameter 값 -> CREO 모델에 Parameter 값으로 입력

■ 개발 방향 "새로고침" 버튼을 클릭하면 현재 활성화된 모델의 매개변수 이름, 타입, 값을 엑셀 파일로 불러 옵니다. 엑셀에서 매개변수 값을 변경하고 "저장" 버튼을 클릭하면, 해당 하는 매개

tool-2020.tistory.com

 

제품 사이즈를 구하는 기능도 개발 하지 않았습니다. 제품 사이즈는 모델을 쉬링크 랩으로 변경후 사이즈를 계산 합니다.

 


데이터 베이스는 엑셀에서 입력한 내용을 액세스로 저장 하는 기능 입니다.  MS  오피스를 구매하면 액세스가 있느 제품이 있습니다.  설계자는 CREO로 설계가 완료되면, 원시데이터를 엑셀 파일로 저장 합니다. 액새스에서 데이터를 가공하여, 필요한 엑셀 파일로 보낼수 있습니다. 

 

액세스는 데이터 베이스 입니다. 엑셀에서는 다양한 데이터 베이스에서 데이터를 가져 올수 있습니다.