개발 요청] 이미지 생성 프로그램 #3

□ 단순화 표현 만들기

2개의 모듈을 사용 합니다.

1. Creo와 연결 하는 코드 (모듈 이름:CreoVBAStart)

Option Explicit
Public asynconn As New pfcls.CCpfcAsyncConnection
Public conn As pfcls.IpfcAsyncConnection
Public BaseSession As pfcls.IpfcBaseSession
Public Model As pfcls.IpfcModel
Public Sub CreoConnt01()
     
     '// connect creo model
     Set conn = asynconn.Connect(Null, Null, Null, Null)
     Set BaseSession = conn.Session
     Set Model = BaseSession.CurrentModel
     
    '// creo model connection check
     If Model Is Nothing Then
        MsgBox "There are No Active Creo Models", vbInformation, "korealionkk@gmail.com"
        Exit Sub
     End If
               
End Sub

 

2. 어셈블을 구성하는 모델의 이름을 모두 가져오는 모듈 ( 모듈 이름 : AssemblyUtils)

Option Explicit
Private pathArray As Collection
Private useAsm As IpfcAssembly
'======================================================================
'This function returns an array of all ComponentPath's to all component parts ('leafs') in an assembly.
'======================================================================
Public Function listEachLeafComponentPath(ByVal assemblyIn As IpfcAssembly) As Collection
    Dim startLevel As New Cintseq
    Dim i As Integer
    
    '// assemblyIn 타입 확인
    If assemblyIn Is Nothing Then
        MsgBox "The input assembly is not initialized.", vbCritical, "Error"
        Exit Function
    End If

    If Not TypeOf assemblyIn Is IpfcAssembly Then
        MsgBox "The input model is not an assembly.", vbCritical, "Error"
        Exit Function
    End If
    
    Set pathArray = New Collection
    Set useAsm = assemblyIn
    
    Call listSubAsmComponents(startLevel)
  
    Dim compPaths() As IpfcComponentPath
    ReDim compPaths(pathArray.Count)
    
        For i = 0 To (pathArray.Count - 1)
                Set compPaths(i) = pathArray.item(i + 1)
        Next i
        
    Set listEachLeafComponentPath = pathArray

End Function

'================================================================================
'This function is used to recursively visits all levels of the assembly structure.
'================================================================================
Private Function listSubAsmComponents(ByVal currentLevel As Cintseq)
    Dim currentComponent As IpfcSolid
    Dim currentComponentModel As IpfcModel
    Dim currentPath As IpfcComponentPath
    Dim ComponentFeat As IpfcModelItem
    Dim subComponents As IpfcFeatures
    Dim compIds As New Cintseq
    Dim CMpfcAssembly_ As New CMpfcAssembly
    Dim i, id, level As Integer
    
    
        level = currentLevel.Count
        
                '======================================================================
                'Special case, level is 0 for the top level assembly.
                '======================================================================
            If level > 0 Then
                Set currentPath = CMpfcAssembly_.CreateComponentPath(useAsm, currentLevel)
                Set currentComponent = currentPath.Leaf
                Set currentComponentModel = currentPath.Leaf
                
                Else
                    
                    Set currentComponent = useAsm
                    Set currentComponentModel = useAsm
                    
            End If
              
              
            If (currentComponentModel.Type = EpfcMDL_PART) And (level > 0) Then
                    pathArray.Add currentPath
                Else
                
                If Not currentPath Is Nothing Then
                    pathArray.Add currentPath
                End If
                
                
                    '======================================================================================================================
                    'Find all component features in the current component object. Visit each (adjusting the component id paths accordingly).
                    '======================================================================================================================
                    
                    Set subComponents = currentComponent.ListFeaturesByType(False, EpfcFeatureType.EpfcFEATTYPE_COMPONENT)
                        
                        For i = 0 To (subComponents.Count - 1)
                            If (subComponents.item(i).Status = EpfcFeatureStatus.EpfcFEAT_ACTIVE) Then ''//Collect only Active Components
                                Set ComponentFeat = subComponents.item(i)
                                id = ComponentFeat.id

                                currentLevel.Set level, id
                                
                                
                                Call listSubAsmComponents(currentLevel)
                            End If
                        Next i
            End If
            '======================================================================
            'Clean up current level of component ids before returning up one level.
            '======================================================================
            If Not level = 0 Then
            currentLevel.Remove level - 1, level
            End If
      
End Function

 

3. 새로운 단순화 표현 만들기 + 모델 추카 코드 => 새로운 단순화 표현에 부품이 추가 되지 않습니다.

 '// Module Name : CreoVBAStart   => Creo 모델과 연결 합니다
    Call CreoVBAStart.CreoConnt01

 '// Function Name : listEachLeafComponentPath => 어셈블의 말단의 부품들의 객체를 가져옵니다.
 Set AsmPathArray = AssemblyUtils.listEachLeafComponentPath(AsmModel)

Option Explicit
Sub SimplifiedRep01()
    On Error GoTo RunError
    Application.EnableEvents = False

    '// Module Name : CreoVBAStart
    Call CreoVBAStart.CreoConnt01
    
    Dim AsmPathArray As Collection
    Dim ComponetModel As pfcls.IpfcModel
    Dim AsmModel As IpfcAssembly
    Set AsmModel = Model
    
    
     Dim iCnt, jCnt, kCnt As Integer
     Dim eachPath As IpfcComponentPath
     Dim ComponetIDIintseq As Iintseq
        
     '// Function Name : listEachLeafComponentPath
    Set AsmPathArray = AssemblyUtils.listEachLeafComponentPath(AsmModel)
    
    '// MsgBox Model.fileName, vbInformation, "korealionkk@gmail.com"
    
    '// Function SimplifiedRep :
    Dim SimplifiedRepSolid As IpfcSolid
    Dim Simrep As IpfcSimpRep
    Dim CreateNewSimpRepInstructions As New CCpfcCreateNewSimpRepInstructions
    Dim NewSimpRepInstructions As IpfcCreateNewSimpRepInstructions
    Dim SimpRepInstructions As IpfcSimpRepInstructions
    Dim simpRepName As String
          
    Set SimplifiedRepSolid = Model
    simpRepName = "MySimplifiedRep" '//

     '// Adding items to simplified representation
     Dim CreateSimpRepItem As New CCpfcSimpRepItem
     Dim SimpRepItem As IpfcSimpRepItem
     Dim SimpRepAction As IpfcSimpRepAction
     Dim SimpRepItems As IpfcSimpRepItems
     Set SimpRepItems = New CpfcSimpRepItems
     
     Dim CreateSimpRepCompItemPath As New CCpfcSimpRepCompItemPath
     Dim SimpRepCompItemPath As IpfcSimpRepCompItemPath
     Dim SimpRepItemPath As IpfcSimpRepItemPath
     Dim CreateSimpRepIncludeas As New CCpfcSimpRepInclude
     Dim SimpRepInclude As IpfcSimpRepInclude
     
    
    kCnt = 0

    For iCnt = 0 To (AsmPathArray.Count - 1)
                
            Set eachPath = AsmPathArray.item(iCnt + 1)
            Set ComponetModel = eachPath.Leaf
            Set ComponetIDIintseq = eachPath.ComponentIds
            
                If ComponetModel.Type = 1 Then
    
                    Worksheets("Suppress").Cells(kCnt + 6, "A") = kCnt + 1
                    Worksheets("Suppress").Cells(kCnt + 6, "B") = ComponetModel.fileName
                    Worksheets("Suppress").Cells(kCnt + 6, "C") = "Part"
                    
                       If ComponetIDIintseq.Count = 1 Then
                               Worksheets("Suppress").Cells(kCnt + 6, "D") = ComponetIDIintseq.item(0)
                        Else
                                For jCnt = 0 To ComponetIDIintseq.Count - 1
                                        Worksheets("Suppress").Cells(kCnt + 6, jCnt + 4) = ComponetIDIintseq.item(jCnt)
                                Next jCnt
                        End If
                        
                    '// Adding items to simplified representation
                    Set SimpRepCompItemPath = CreateSimpRepCompItemPath.Create(ComponetIDIintseq)
                    Set SimpRepItem = CreateSimpRepItem.Create(SimpRepCompItemPath)
                    Set SimpRepInclude = CreateSimpRepIncludeas.Create
                    
                    SimpRepItem.Action = SimpRepInclude
                    Call SimpRepItems.Append(SimpRepItem)
                    
                    '// Creating a new simplified representation object
                    Set NewSimpRepInstructions = CreateNewSimpRepInstructions.Create(simpRepName & (kCnt + 1))
                    Set Simrep = SimplifiedRepSolid.CreateSimpRep(NewSimpRepInstructions)
                    
                    Set SimpRepInstructions = NewSimpRepInstructions
                    SimpRepInstructions.DefaultAction = EpfcSimpRepActionType.EpfcSIMPREP_EXCLUDE
                    SimpRepInstructions.IsTemporary = False
                    SimpRepInstructions.Items = SimpRepItems
                    
                    Call Simrep.SetInstructions(SimpRepInstructions)
                    
                    Worksheets("Suppress").Cells(kCnt + 6, "F") = simpRepName & (kCnt + 1)

                    kCnt = kCnt + 1
                 
                 End If
                        
    Next iCnt
       
     MsgBox "Completed Creation of Simplified Representation", vbInformation, "korealionkk@gmail.com"
       
    conn.Disconnect (2)
    
    
    '// Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set BaseSession = Nothing
    Set Model = Nothing
    
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

 

TOOLBOX_VBA_v1.xlsm

0.05MB

---