반응형
■ 소개
VBA 프로그램을 사용하여 자동으로 Creo 프로그램을 실행 할수 있습니다. 또한 Creo part 파일을 자동으로 open 할수 있습니다. 입력한 치수값을 모델에 대입하고, 새로운 Creo 파일 (3D, 2D)를 생성 할 수 있습니다. VBA 프로그램을 사용하여 자동으로 Creo 프로그램을 강제로 Kill 할수 있습니다.
. Template 모델을 open 하고, 엑셀 파일에 입력된 치수 값을 모델에 적용.
. Part 파일이 가지고 있는 특정 Feature를 삭제. (옵션 기능)
. 변경된 치수 값으로 새로운 모델 (3D/ 2D)만들기.
■ 엑셀 매크로 파일에서 CREO 프로그램을 실행 할수 있습니다.
Option Explicit
Sub CreoExecution()
Dim asynconn As New pfcls.CCpfcAsyncConnection
Dim conn As pfcls.IpfcAsyncConnection
Set conn = asynconn.Start("C:\PTC\Creo 8.0.6.0\Parametric\bin\parametric.bat", "")
End Sub
엑셀 매크로 파일 화면이 껌벅거리는 현상을 제거 하려면 아래 코드를 추가 합니다
Application.ScreenUpdating = False '// 화면 업데이트 정지
■ 엑셀 매크로 파일에서 CREO 프로그램을 kill 할수 있습니다.
Option Explicit
Sub CreoShotDown()
Dim asynconn As New pfcls.CCpfcAsyncConnection
Dim conn As pfcls.IpfcAsyncConnection
conn.End
End Sub
▶참고 사이트
■ 특정 폴더에 있는 Creo 파일 Open 하기
Sub TemplateFileOpen()
Dim asynconn As New pfcls.CCpfcAsyncConnection
Dim conn As pfcls.IpfcAsyncConnection: Set conn = asynconn.Connect("", "", ".", 5)
Dim oSession As pfcls.IpfcBaseSession: Set oSession = conn.Session
Dim oModel As IpfcModel
Dim oCreateModelDescriptor As New CCpfcModelDescriptor
Dim oModelDescriptor As IpfcModelDescriptor
Set oModelDescriptor = oCreateModelDescriptor.CreateFromFileName("template_code01.prt")
Set oModel = oSession.RetrieveModel(oModelDescriptor) '//모델을 Session으로 가져오기
oModel.display '// 모델 활성화 하기
conn.Disconnect (2)
▶참고 사이트
■ 모델의 Dimension 값 표시 하기
모델이 가지고 있는 치수 이름을 모두 표시 합니다. 치수 값을 모두 표시 합니
Option Explicit
Sub TemplateFileOpen()
Dim asynconn As New pfcls.CCpfcAsyncConnection
Dim conn As pfcls.IpfcAsyncConnection: Set conn = asynconn.Connect("", "", ".", 5)
Dim oSession As pfcls.IpfcBaseSession: Set oSession = conn.session
Dim oModel As IpfcModel
Dim owindow As IpfcWindow
Dim oCreateModelDescriptor As New CCpfcModelDescriptor
Dim oModelDescriptor As IpfcModelDescriptor
Set oModelDescriptor = oCreateModelDescriptor.CreateFromFileName("template_code01.prt")
Set oModel = oSession.RetrieveModel(oModelDescriptor) '//Creo Session으로 모델불러오기
oModel.Display
Dim oSolid As IpfcSolid: Set oSolid = oModel
Dim oModelItemOwner As IpfcModelItemOwner: Set oModelItemOwner = oSolid
Dim oDimensionList As IpfcModelItems: Set oDimensionList = oModelItemOwner.ListItems(EpfcITEM_DIMENSION) '//Dimension List
Dim oDimValue As IpfcBaseDimension
Dim i As Long
For i = 0 To oDimensionList.Count - 1
Cells(i + 5, "A") = oDimensionList(i).GetName '//Dimension Name
Set oDimValue = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, Cells(i + 5, "A"))
Cells(i + 5, "B") = oDimValue.DimValue '// Dimension Value
Next i
conn.Disconnect (2)
End Sub
▶참고 사이트
■ VBA Template 프로그램
- Part 파일을 새로운 파일로 저장 합니다. 도면과 함께 저장 합니다.
- 모델에서 치수의 이름은 반드시 "대문자"로 시작 해야 합니다. 프로그램 "Dimesion Name"과 동일 해야 합니다.
- "Dimesion Value"는 "음수"를 대입 할수 없습니다.
- Template 모델은 Config.pro "search_path"에 정의 되어 있어야 합니다
- Drawing Format 파일은 Config.pro "format_dir"에 정의 되어 있어야 합니다
■ VBA 코드
Option Explicit
Sub TemplateFileOpen()
On Error GoTo RunError
Dim asynconn As New pfcls.CCpfcAsyncConnection
Dim conn As pfcls.IpfcAsyncConnection
Set conn = asynconn.Start("C:\PTC\Creo 9.0.2.0\Parametric\bin\parametric.bat", "") '//Creo File Open
Set conn = asynconn.Connect("", "", ".", 5)
Dim oSession As pfcls.IpfcBaseSession: Set oSession = conn.session
oSession.ChangeDirectory ("C:\PTC\WORK90")
Dim oModel As IpfcModel
Dim owindow As IpfcWindow
Dim oTemplateName As String: oTemplateName = Cells(7, "D") '//Template Model Name
Dim oCreateModelDescriptor As New CCpfcModelDescriptor
Dim oModelDescriptor As IpfcModelDescriptor
Set oModelDescriptor = oCreateModelDescriptor.CreateFromFileName(oTemplateName)
Set oModel = oSession.RetrieveModel(oModelDescriptor) '//Creo Session으로 모델불러오기
oModel.Display
' Current Creo Wokrfolder
Cells(8, "D") = oSession.GetCurrentDirectory
Dim oSolid As IpfcSolid: Set oSolid = oModel
Dim oModelItemOwner As IpfcModelItemOwner: Set oModelItemOwner = oSolid
Dim oDimValue As IpfcBaseDimension
' Dimension Name List Count
Dim rng As Range
Set rng = Range("D11", Cells(Rows.Count, "D").End(xlUp))
Dim i As Long
For i = 0 To rng.Count - 1
Set oDimValue = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, Cells(i + 11, "E"))
Cells(i + 11, "F") = oDimValue.DimValue
Next i
'conn.Disconnect (2)
conn.End
MsgBox "All dimension values have been displayed", vbInformation, "www.idt21c.com"
'Cleanup
Set asynconn = Nothing
Set conn = Nothing
Set oSession = Nothing
Set oModel = Nothing
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
■ 동영상
'VBA For Creo' 카테고리의 다른 글
Create Creo Parameter (0) | 2022.12.16 |
---|---|
Template 프로그램 #2 (0) | 2022.12.09 |
의뢰] Part List 프로그램 Customizing A02 (2) | 2022.12.07 |
도면 자동 생성 기능 (0) | 2022.11.30 |
의뢰] Part List 프로그램 변형 A01 (0) | 2022.11.25 |