일정 범위 값 안에 있는 Creo의 치수 값들을 자동으로 변경 할수 있습니다. 기계적으로 자동 변경된 치수값은 Creo 모델을 자동 변경 하며, 측정 Feature의 Parameter 값을 변경 합니다.
Analysis > Mass Properties 기능을 사용 하여 "Gravity" Feature를 생성 합니다.
■ 측정 Feature의 로컬 매개변수 값 가져오기 코드
Sub Feature_localparameter()
On Error GoTo RunError
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 File 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
Dim oModelItemOwner As IpfcModelItemOwner: Set oModelItemOwner = model
'Analysis Feature Name : "GRAVITY"
Dim oModelItem As IpfcModelItem
Set oModelItem = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_FEATURE, "GRAVITY")
Dim oParameterOwner As IpfcParameterOwner: Set oParameterOwner = oModelItem
'Local Parameter Name : "SURF_AREA"
Dim oParameter As IpfcParameter: Set oParameter = oParameterOwner.GetParam("SURF_AREA")
Dim oBaseParameter As IpfcBaseParameter: Set oBaseParameter = oParameter
Dim oParamValue As IpfcParamValue: Set oParamValue = oBaseParameter.Value
'Local Parameter Value Type : DoubleValue
MsgBox oParamValue.DoubleValue
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
■ Dimension 값 변경 하기 코드
Feature에 정의된 Dimension 이름의 값을 가져오고, 자동으로 변경 하는 프로그램 입니다. Creo에서 Dimension 이름은 반드시 영문자 대문자로 시작합니다. 육면체를 모델링 하였으며, 가로*세로* 높이 치수로 구성 하였고, 치수 이름을 "DIM01", "DIM02", "DIM03"으로 정의 하였습니다. 치수 값을 "60,5", "90,5","20.5"로 변경하여 모델을 변경 합니다.
Sub Feature_LIST2()
On Error GoTo RunError
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
'Dimension Name 정의
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
Dim oDimensionName As String
Dim oDimensionValue As Double
Dim i As Integer, j As Integer, k As Integer
oDim01value.DimValue = 60.5
oDim02value.DimValue = 90.5
oDim03value.DimValue = 20.5
'SET Regenerate
Dim RegenInstructions As New CCpfcRegenInstructions
Dim Instrs As IpfcRegenInstructions: Set Instrs = RegenInstructions.Create(True, True, Nothing)
Call session.SetConfigOption("regen_failure_handling", "resolve_mode")
Dim Solid As IpfcSolid: Set Solid = model
Call Solid.Regenerate(ForceRegen)
Call Solid.Regenerate(ForceRegen)
Call session.SetConfigOption("regen_failure_handling", "no_resolve_mode")
'Window Repaint
Dim window As pfcls.IpfcWindow
Set window = session.CurrentWindow
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
■ FOR NEXT 문을 사용한 코드
"DIM01" 값 "10"을 + 1 만큼 증가 하여 12까지 변경 합니다. "DIM02" 값 "20"을 + 1 만큼 증가 하여 22까지 변경 합니다. "DIM03" 값 "30"을 + 1 만큼 증가 하여 32까지 변경 합니다. 변경 된 값을 조합하여, 모델이 가지고 있는 "GRAVITY" Feature의 로컬 매개변수 "mass" 값을 표시 합니다
'VBA For Creo' 카테고리의 다른 글
측정 Feature의 매개변수 값 가져오기 #3 (1) | 2022.09.16 |
---|---|
측정 Feature의 매개변수 값 가져오기 #2 (0) | 2022.09.15 |
모델의 Feature 정보 알아보기 (0) | 2022.09.08 |
Materials : Creo 모델에 지정된 재질 파일 검색 (0) | 2022.09.07 |
엑셀의 Parameter 값 -> CREO 모델에 Parameter 값으로 입력 (0) | 2022.09.05 |