1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
| Sub catiadaochuchicun()
'定义数据类型
'Catia文档类型
Dim doc As DrawingDocument
Dim sheets As DrawingSheets
Dim sheet As DrawingSheet
Dim views As DrawingViews
Dim view As DrawingView
Dim dimensions As DrawingDimensions
'初始化
Dim dn As Integer
Dim ex As Object
Dim dX As Integer
'定义公差数据类型
Dim oTolType As Long
Dim oDisplayMode As Long
Dim oTolName As String
Dim oUpTolS As String
Dim oLowTolS As String
Dim oUpTolD As Double
Dim oLowTolD As Double
Set doc = CATIA.ActiveDocument
Set sheets = doc.sheets
sheetscount = sheets.Count
Set sheet = sheets.ActiveSheet
sheetscount = sheets.Count
Set views = sheet.views
viewscount = views.Count '视图数量
'计算当前页面中尺寸的数量
dn = 0
For i = 1 To viewscount
Set view = views.Item(i)
Set dimensions = view.dimensions
dn = dimensions.Count + dn
Next
'定义动态数组用于存储尺寸数据
Dim myvlaue() As Double
ReDim myvlaue(1 To dn, 1 To dn)
Dim shangcha() As String
ReDim shangcha(1 To dn, 1 To dn)
Dim xiacha() As String
ReDim xiacha(1 To dn, 1 To dn)
'在动态数组中存储数据
Set ex = CreateObject("Excel.Application")
Set exwbook = ex.Workbooks().Add
Set exsheet = exwbook.Worksheets("sheet1")
'在excel里表格的表头
ex.Range("a2").Value = "序号"
ex.Range("b2").Value = "尺寸数据"
ex.Range("c2").Value = "上差"
ex.Range("d2").Value = "下差"
'ex.Range("e2").Value = "单位"
'提取尺寸数据及公差并写入excel
dX = 0
For J = 1 To viewscount
Set view = views.Item(J)
Set dimensions = view.dimensions
DT = dimensions.Count
For A = 1 To DT
Set dimension = dimensions.Item(A)
Number = dimension.GetValue.Value
oUpTolD = 0
oLowTolD = 0
dimension.GetTolerances oTolType, oTolName, oUpTolS, oLowTolS, oUpTolD, oLowTolD, oDisplayMode
myvlaue(J, A) = Number
shangcha(J, A) = oUpTolD
xiacha(J, A) = oLowTolD
'MsgBox myvlaue(J, A)
' MsgBox A
ex.Range("b" & A + dX).Value = myvlaue(J, A)
ex.Range("c" & A + dX).Value = shangcha(J, A)
ex.Range("d" & A + dX).Value = xiacha(J, A)
'If A = DT Then
'ex.Range("b" & A + 3 + dX).Clear
'ex.Range("c" & A + 3 + dX).Clear
'ex.Range("d" & A + 3 + dX).Clear
'End If
Next
dX = dimensions.Count + dX + 1
Next
For i = 1 To dn + viewscount - 3
ex.Range("a" & i + 2).Value = i
Next
exwbook.SaveAs "F:\OneDrive\工作\catia插件\CATIA 插件\记录.xls"
ex.Quit
End
End Sub
|
