#2 quilt의 면적 표시 - 고급 편

□ 소개

50개의 치수 조합을 자동으로 모델에 대입 하여, quilt의 면적을 자동으로 표시 하는 프로그램 입니다.
치수 조합은 Array 기능을 이용하여 개발 하였습니다

▷ 참고 사이트

quilt의 면적 표시

 

Array 공부 - 치수 값을 조합 하여 화면에 표시하기

 

치수의 조합은 50개 입니다. 오른쪽 그림과 같이 변경 가능한 치수 이름을 정의 합니다. 표면적은 여러개의 서피스를 합친 "KOREA" 이름의 quilt 입니다. 치수 이름 : DIM01, DIM02 (반드시 대문자만 사용) quilt 이름 : KOREA  (반드시 대문자만 사용)

 

▷ 코드

Sub autodim()
     '// 치수 조합
    dimCombination.dimCombination

    '// 현재 세션 연결
    file_name.model_session
    Cells(5, "D") = model.Filename
    
    '// SET Regenerate
    Dim solid As IpfcSolid
    Dim RegenInstructions As New CCpfcRegenInstructions
    Dim Instrs As IpfcRegenInstructions
    Set solid = model
    Set Instrs = RegenInstructions.Create(False, False, Nothing)
     
    '// SET Dimension
    Dim Modelowner As IpfcModelItemOwner
    Dim dim01ModelItem As IpfcModelItem
    Dim dim01BaseDimension As IpfcBaseDimension
    Dim dim02ModelItem As IpfcModelItem
    Dim dim02BaseDimension As IpfcBaseDimension
    
    Set Modelowner = model
    Set dim01ModelItem = Modelowner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, "DIM01")
    Set dim01BaseDimension = dim01ModelItem
    
    Set dim02ModelItem = Modelowner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, "DIM02")
    Set dim02BaseDimension = dim02ModelItem
      
    Dim dimcountrange As Range
    Set dimcountrange = Worksheets("Area").Range("H7", Cells(Rows.Count, "H").End(xlUp))
    
    '// SET quiltarea
    Dim QuiltmodelItem As IpfcModelItem
    Dim Quilt As IpfcQuilt
    Dim Surfaces As IpfcSurfaces
    Dim Surface As IpfcSurface
    
    Set QuiltmodelItem = Modelowner.GetItemByName(EpfcModelItemType.EpfcITEM_QUILT, "KOREA")
    Set Quilt = QuiltmodelItem
    Set Surfaces = Quilt.ListElements
    
    Dim q As Integer

    '//quilt 면적 값 표시 변수
    Dim quiltarea As Double
    Dim totalquiltarea As Double

    Dim i As Integer
    
    For i = O To dimcountrange.Count - 1
    
            dim01BaseDimension.DimValue = Cells(7 + i, "H")
            dim02BaseDimension.DimValue = Cells(7 + i, "I")
            
            Call solid.Regenerate(Instrs) '// Regenerate 실행
            
            For q = 0 To Surfaces.Count - 1
                
                Set Surface = Surfaces(q)
                quiltarea = Surface.EvalArea
                totalquiltarea = totalquiltarea + quiltarea
                
            Next q
            
            Cells(7 + i, "j") = totalquiltarea
            totalquiltarea = 0
    Next i
    
End Sub

 

▷프로그램 실행전

 

▷ 프로그램 실행 결과

 

모델 Download (CREO 9.0)

idt-korea01.prt.1

0.14MB

 

VBA 프로그램 Download

ToolBOX VBA by IDT -01.xlsm

0.06MB

 

▷ 프로그램 실행 동영상

---

영업문의 : lionkk@idt21c.com
카카오 채널 : http://pf.kakao.com/_fItAxb