모델의 치수 값을 자동으로 변경 하여, 무게 측정 Feature의 Mass 값 가져오는 프로그램 입니다.
치수 이름 "DIM01"을 시작 값 10.5로 변경 하고, 10씩 증가 시켜 1000이 될때까지 모델을 변경 합니다
그때 자동으로 변경되는 측정 Feature의 로컬 매개 변수 값을 가져 오는 프로그램 입니다.
치수 이름은 모델에서 유니크 (unique)합니다.
▶ 소스 코드
Sub Feature_LIST2()
On Error GoTo RunError
' CurrentModel 연결
Dim asynconn As New pfcls.CCpfcAsyncConnection
Dim conn As pfcls.IpfcAsyncConnection: Set conn = asynconn.Connect("", "", ".", 5)
Dim session As pfcls.IpfcBaseSession: Set session = conn.session
Dim model As IpfcModel: Set model = session.CurrentModel
'Model Path Name
Cells(1, "c").Select: Selection.ClearContents
Cells(1, "c") = session.GetCurrentDirectory
'Model File Name
Cells(1, "D").Select: Selection.ClearContents
Cells(1, "D") = model.Filename
'기존 Cells 의 내용 초기화
Range(Cells(3, "A"), Cells(Rows.Count, "A")).EntireRow.Delete
'Creo Dimension 개체 정의
' IpfcModelItem 변수에 모델에 정의된 "DIM01", "DIM02", "DIM03" 개체 가져오기
Dim oModelItemOwner As IpfcModelItemOwner: Set oModelItemOwner = model
Dim oDIM01 As IpfcModelItem
Dim oDIM02 As IpfcModelItem
Dim oDIM03 As IpfcModelItem
Set oDIM01 = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, "DIM01")
Set oDIM02 = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, "DIM02")
Set oDIM03 = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, "DIM03")
Dim oDim01value As IpfcBaseDimension: Set oDim01value = oDIM01
Dim oDim02value As IpfcBaseDimension: Set oDim02value = oDIM02
Dim oDim03value As IpfcBaseDimension: Set oDim03value = oDIM03
'Dimension 개체에서 이름 및 값 가져오는 변수 정의
Dim oDimensionName As String
Dim oDimensionValue As Double
Dim i As Double, j As Integer, k As Integer: k = 0
'모델의 "GRAVITY" Feature 개체의 변수 (변수 이름 : oModelItem) 정의
Dim oModelItem As IpfcModelItem
Set oModelItem = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_FEATURE, "GRAVITY")
' "GRAVITY" Feature 개체의에서 로컬 매개변수 개체 가져오기
Dim oParameterOwner As IpfcParameterOwner: Set oParameterOwner = oModelItem
' 프로그램으로 치수 값 변경을 하려면 반드시 Config,pro 옵션을 추가 해야한다,
' "resolve_mode" 설정이 안되면 치수 값 변경이 불가능 하다
Call session.SetConfigOption("regen_failure_handling", "resolve_mode")
' 치수 값이 변경되어 자동으로 mass 값을 변경 하려면 반드시 "automatic"으로 설정 해야 한다.
Call session.SetConfigOption("mass_property_calculate", "automatic")
For i = 0 To 1000 Step 10
k = k + 1
oDim01value.DimValue = 10.5 + i " 모델의 초기 값
Cells(k + 2, 1) = k " 번호 항목
Cells(k + 2, 2) = 10.5 + i " DIM01 항목
'SET Regenerate
Dim RegenInstructions As New CCpfcRegenInstructions
Dim Instrs As IpfcRegenInstructions: Set Instrs = RegenInstructions.Create(True, True, Nothing)
Dim Solid As IpfcSolid: Set Solid = model
Call Solid.Regenerate(ForceRegen)
Call Solid.Regenerate(ForceRegen) " 관계식 값 변경을 위해 실행
'Local Parameter Name : "mass"
Dim oParameter As IpfcParameter: Set oParameter = oParameterOwner.GetParam("mass")
Dim oBaseParameter As IpfcBaseParameter: Set oBaseParameter = oParameter
Dim oParamValue As IpfcParamValue: Set oParamValue = oBaseParameter.Value
'Local Parameter Value Type : DoubleValue
Cells(k + 2, 5) = oParamValue.DoubleValue
'Window Repaint
Dim window As pfcls.IpfcWindow
Set window = session.CurrentWindow
window.Repaint
Next i
'CREO Config.pro 초기화
Call session.SetConfigOption("regen_failure_handling", "no_resolve_mode")
Call session.SetConfigOption("mass_property_calculate", "by_request")
conn.Disconnect (2)
'Cleanup
Set asynconn = Nothing
Set conn = Nothing
Set session = Nothing
Set model = 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
▶ 프로그램 실행
By : lionkk@idt21c.com
'VBA For Creo' 카테고리의 다른 글
Creo Dimension을 Regenerate 하는 코드 (0) | 2022.09.19 |
---|---|
측정 Feature의 매개변수 값 가져오기 #3 (1) | 2022.09.16 |
측정 Feature의 매개변수 값 가져오기 #1 (0) | 2022.09.09 |
모델의 Feature 정보 알아보기 (0) | 2022.09.08 |
Materials : Creo 모델에 지정된 재질 파일 검색 (0) | 2022.09.07 |