반응형
도면에 배치된 치수를 표시합니다
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의 드로잉 뷰를 나타냅니다. 뷰를 삭제 이동 할수 있습니다.
현재 drawing sheet에서 View 이름 View2Ds에 배열 저장 합니다.
'2D Views List
Dim View2Ds As IpfcView2Ds
Set View2Ds = Model2D.List2DViews()
Dim View2D As IpfcView2D
View2Ds에 저장된것 - 도면에 뷰는 1개만 표시 하였습니다
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
'VBA For Creo' 카테고리의 다른 글
치수 값을 자동으로 대입 하여, 모델 면적 표시하기 (0) | 2021.03.30 |
---|---|
Feature ID 및 Feature 이름 검색 프로그램 # 2/3 (0) | 2021.03.22 |
Drawing View List (0) | 2021.03.08 |
returns a list of all the solid models used in the drawing. (0) | 2021.03.08 |
Creo Drawing In Session (0) | 2021.03.08 |