본문 바로가기
  • Welcome!
VBA For Creo

developing . . . . Drawing Dimension All Display With Tolerence

by ToolBOX01 2021. 3. 13.
반응형

도면에 배치된 치수를 표시합니다

Display dimensions linked to the drawing

 

공차와 함께 표시하는 프로그램 입니다

This is a program that displays with tolerances

 


1. Drawing Sheet

 

IpfcSheetOwner Object

시트가 포함 된 모델을 나타냅니다. 시트의 추가, 삭제 , 스케일 등을 할 수 있습니다.

 

IpfcModel2D Object 

2 차원 Creo Parametric 모델을 나타냅니다. 도면에 모델을 추가 하거나, 치수를 추가 할수 있습니다. 

 

        Dim SheetOwner As IpfcSheetOwner
        Set SheetOwner = Model
        Dim Model2D As IpfcModel2D
        Set Model2D = SheetOwner

 

 

2. Drawing Sheet의 뷰 List를 표시 하는 Code

 

IpfcView2D Object

Creo Parametric의 드로잉 뷰를 나타냅니다.  뷰를 삭제 이동 할수 있습니다.

 

Creo Drawing View Tree

현재 drawing sheet에서 View 이름 View2Ds에 배열 저장 합니다.

 

 

        '2D Views List
        Dim View2Ds As IpfcView2Ds
        Set View2Ds = Model2D.List2DViews()
        Dim View2D As IpfcView2D

 

 

View2Ds에 저장된것 - 도면에 뷰는 1개만 표시 하였습니다

parameter 'View2ds'

 

1. Count   1 -> 뷰 수량 Count

2. Name   "VIEW_TEMPLATE_1" -> Drawing View Name

 

 

3. Sorce Code

 

 

Sub dimension2d_list()
        Dim asynconn As New pfcls.CCpfcAsyncConnection
        Dim conn As pfcls.IpfcAsyncConnection
        Dim session As pfcls.IpfcBaseSession
    
    On Error GoTo RunError
        Set conn = asynconn.Connect("", "", ".", 5)
        Set session = conn.session
                     
        Dim Model As IpfcModel
        Set Model = session.CurrentModel
        Cells(3, "C") = Model.Filename
        
        'Cells reset
        Range(Cells(7, "A"), Cells(Rows.Count, "A")).EntireRow.Delete
        
        Dim SheetOwner As IpfcSheetOwner
        Set SheetOwner = Model
        Dim Model2D As IpfcModel2D
        Set Model2D = SheetOwner
        
        '2D Views List
        Dim View2Ds As IpfcView2Ds
        Set View2Ds = Model2D.List2DViews()
        Dim View2D As IpfcView2D
        
        Dim ModelItemOwner As IpfcModelItemOwner
        Dim Dimensions As IpfcModelItems
        Dim Dimension2D As IpfcBaseDimension
        Dim DrawingDimension As IpfcDimension2D
        
        Dim cellsCount As Integer
        cellsCount = 0
                    
        Dim i As Integer
        Dim j As Integer
        
        For i = 0 To View2Ds.Count - 1
            Set View2D = View2Ds(i)
            Cells(i + 7 + cellsCount, "a") = i + 1
            Cells(i + 7 + cellsCount, "b") = View2D.Name
            Set ModelItemOwner = View2D.GetModel
            Set Dimensions = ModelItemOwner.ListItems(EpfcModelItemType.EpfcITEM_DIMENSION)
        
                For j = 0 To Dimensions.Count - 1
                    Set Dimension2D = Dimensions(j)
                        
                        Cells(i + 7 + j + cellsCount, "c") = Dimension2D.Symbol
                        Cells(i + 7 + j + cellsCount, "d") = Dimension2D.DimValue
                        
                        If Dimension2D.DimType = 0 Then
                           Cells(i + 7 + j + cellsCount, "e") = "Linear"
                            ElseIf Dimension2D.DimType = 1 Then
                                   Cells(i + 7 + j + cellsCount, "e") = "Radial"
                                   ElseIf Dimension2D.DimType = 2 Then
                                          Cells(i + 7 + j + cellsCount, "e") = "Diameter"
                                   Else
                                          Cells(i + 7 + j + cellsCount, "e") = "Angular"
                        
                        End If
                Next j
                
                cellsCount = cellsCount + Dimensions.Count
        
        Next i
     
                       
    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