在CATIA中利用VBA读取EXCEL中的数据
2012-06-06 16:45阅读：
本程序可以把EXCEL表格中按一定格式存储的点、线、面等数据读取到CATIA并创建相应的对象
http://blog.163.com/nuaa_wjz/blog/static/228734772008128111049315/
'点数据是基本数据，线由点组成，面又由线组成，因此只有填写了点数据后才能添加线数据，
'面与线类似。本程序中默认的扩展数据为关键点处的内力数据，其ID应该与点数据的ID一致。
'下表中具体含义：ID—数据编号，（X，Y，Z）—点数据坐标值，（P1，P2）—组成线的点ID，
'（L1，L2）—组成面的线ID，（M，N，Q）—关键点处弯矩、轴力、剪力的数值。
'程序界面如下：
'注意：表格中的数据区可以为空，每一类数据中只要有一行中出现空值，即认为该
'
类数据结束，其后的数据不再读取。本程序启动一次读入一张表格后，其点、线、面
'
数据不应该被改变。但其内力（M，N，Q）的数值允许改变，保存表格后，可以选择更
'
新内力图（如果程序窗口已经关闭，重新启动后不要选中“创建点”后重新打开文件）
'
但一定要保证CATIA中该表格数据所在的几何图形集名称与表格对应，通常默认即可。
'
如果数据表中的点、线、面数据有变，即认为这是一张新的数据表，应该换一个新的文
'
件名并作为新的数据表重新导入，若不改名则请确保当前PART根结点下没有与其文件名
'
相同的几何图形集（此处几何图形集的命名方式为：DATA FORM EXCEL - 文件名）。
'
另外，内力关键点必须在同一平面内，且不在同一直线上。
'默认的EXCLE表格中数据格式如下：
'表格可以扩展，具体格式也可能改变，此时须改变下列常数的值，以保证与表格中的一致
'程序中使用的有关常数定义：
Const Data_Start_Row = 3
Const Point_ID_Col = 1
Const Point_X_Col = 2
Const Point_Y_Col = 3
Const Point_Z_Col = 4
Const Line_ID_Col = 6
Const Line_Point1_Col = 7
Const Line_Point2_Col = 8
Const Mesh_ID_Col = 10
Const Mesh_Line1_Col = 11
Const Mesh_Line2_Col = 12
Const Force_ID_Col = 14
Const Force_M_Col = 15
Const Force_N_Col = 16
Const Force_Q_Col = 17
Dim EXCEL As Object
'*************************************
Private Sub
CreatePoint_CheckBox_Change()
CreateLine_CheckBox.Value = CreatePoint_CheckBox.Value
CreateLine_CheckBox.Enabled = CreatePoint_CheckBox.Value
End Sub
Private Sub
CreateLine_CheckBox_Change()
CreateMesh_CheckBox.Value = CreateLine_CheckBox.Value
CreateMesh_CheckBox.Enabled = CreateLine_CheckBox.Value
End Sub
Private Sub ChooseFile_CommandButton_Click()
On Error GoTo error_1
Set EXCEL = CreateObject('EXCEL.Application',
'')
Dim DataFileName As String
DataFileName = EXCEL.GetOpenFilename('EXCEL Files (*.xls),
*.xls')
If DataFileName <> 'False'
Then
EXCEL.workbooks.Open
DataFileName
MainForm_UserForm.ChooseFile_CommandButton.Caption =
DataFileName
If CreatePoint_CheckBox.Value = True
Then
Dim
Cur_hybridBody As HybridBody
Set
Cur_hybridBody = Set_Cur_HybridBody()
CreatePoint
Cur_hybridBody
If
CreateLine_CheckBox.Value = True Then
CreateLine Cur_hybridBody
If CreateMesh_CheckBox.Value = True
Then
CreateMesh
Cur_hybridBody
End If
End
If
MainForm_UserForm.CreateForce_M_CommandButton.Enabled = True
MainForm_UserForm.CreateForce_N_CommandButton.Enabled = True
MainForm_UserForm.CreateForce_Q_CommandButton.Enabled =
True
End If
End If
Exit Sub
error_1:
EXCEL.Quit
End Sub
Private Function Set_Cur_HybridBody() As HybridBody
On Error GoTo error_1
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridShapeFactory1 As
HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Dim temp_name As String
temp_name =
MainForm_UserForm.ChooseFile_CommandButton.Caption
temp_name = StrConv(Mid(temp_name, InStrRev(temp_name, '') + 1),
1)
k = 0
For N = 1 To hybridBodies1.Count
Set hybridBody1 =
hybridBodies1.Item(N)
If (Left(hybridBody1.Name, Len('DATA FROM
EXCEL - ' + temp_name)) = 'DATA FROM EXCEL - ' + temp_name)
Then
k = k +
1
End If
Next N
If k > 0 Then
'MsgBox 'have same data file!'
hybridBody1.Name = 'DATA FROM EXCEL - ' +
temp_name + '(' + CStr(k) + ')'
End If
Set hybridBody1 = hybridBodies1.Add()
hybridBody1.Name = 'DATA FROM EXCEL - ' + temp_name
Set Set_Cur_HybridBody = hybridBody1
'Max = 1
'For n = 1 To hybridBodies1.Count
' Set hybridBody1 =
hybridBodies1.Item(n)
' If (Left(hybridBody1.Name,
InStrRev(hybridBody1.Name, '.')) = 'DATA FROM EXCEL.') Then
' m =
CInt(Mid(hybridBody1.Name, InStrRev(hybridBody1.Name, '.') +
1))
' If m
>= Max Then
'
Max = m + 1
' End
If
' End If
'Next n
Exit Function
error_1:
EXCEL.Quit
End Function
Private Sub CreatePoint(Cur_hybridBody As
HybridBody)
'On Error GoTo error_1
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridShapeFactory1 As
HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = Cur_hybridBody.HybridBodies.Add()
hybridBody1.Name = 'POINT DATA'
Dim i As Integer
Dim ID As String
Dim X As String
Dim Y As String
Dim Z As String
Dim hybridShapePointCoord1 As
HybridShapePointCoord
For i = Data_Start_Row To 1000
ID = EXCEL.cells(i,
Point_ID_Col).Value
X = EXCEL.cells(i, Point_X_Col).Value
Y = EXCEL.cells(i, Point_Y_Col).Value
Z = EXCEL.cells(i,
Point_Z_Col).Value
If (ID = '' Or X = ''
Or Y = '' Or Z = '') Then
Exit
For
End If
'Dim hybridShapePointCoord1 As
HybridShapePointCoord
Set hybridShapePointCoord1 =
hybridShapeFactory1.AddNewPointCoord(X, Y, Z)
hybridBody1.AppendHybridShape
hybridShapePointCoord1
hybridShapePointCoord1.Name = 'POINT.' +
ID
Next i
part1.Update
Exit Sub
error_1:
EXCEL.Quit
End Sub
Private Sub CreateLine(Cur_hybridBody As
HybridBody)
'On Error GoTo error_1
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridShapeFactory1 As
HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = Cur_hybridBody.HybridBodies.Add()
hybridBody1.Name = 'LINE DATA'
Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = Cur_hybridBody.HybridBodies.Item('POINT
DATA').HybridShapes
Dim i As Integer
Dim ID As String
Dim P1 As String
Dim P2 As String
Dim
hybridShapePointCoord1 As HybridShapePointCoord
Dim reference1 As Reference
Dim hybridShapePointCoord2 As
HybridShapePointCoord
