在CATIA中利用VBA读取EXCEL中的数据.docx

1、在CATIA中利用VBA读取EXCEL中的数据在CATIA中利用VBA读取EXCEL中的数据2008-02-28 23:10:49|分类： 记事本 |标签： |字号大中小订阅 *本程序可以把EXCEL表格中按一定格式存储的点、线、面等数据读取到CATIA并创建相应的对象点数据是基本数据，线由点组成，面又由线组成，因此只有填写了点数据后才能添加线数据，面与线类似。本程序中默认的扩展数据为关键点处的内力数据，其ID应该与点数据的ID一致。下表中具体含义：ID数据编号，（X，Y，Z）点数据坐标值，（P1，P2）组成线的点ID，（L1，L2）组成面的线ID，（M，N，Q）关键点处弯矩、轴力、剪力的数值

2、。程序界面如下： 注意：表格中的数据区可以为空，每一类数据中只要有一行中出现空值，即认为该 类数据结束，其后的数据不再读取。本程序启动一次读入一张表格后，其点、线、面 数据不应该被改变。但其内力（M，N，Q）的数值允许改变，保存表格后，可以选择更 新内力图（如果程序窗口已经关闭，重新启动后不要选中“创建点”后重新打开文件） 但一定要保证CATIA中该表格数据所在的几何图形集名称与表格对应，通常默认即可。 如果数据表中的点、线、面数据有变，即认为这是一张新的数据表，应该换一个新的文 件名并作为新的数据表重新导入，若不改名则请确保当前PART根结点下没有与其文件名 相同的几何图形集（此处几何图形集

3、的命名方式为：DATA FORM EXCEL - 文件名）。 另外，内力关键点必须在同一平面内，且不在同一直线上。默认的EXCLE表格中数据格式如下：表格可以扩展，具体格式也可能改变，此时须改变下列常数的值，以保证与表格中的一致程序中使用的有关常数定义：Const Data_Start_Row = 3Const Point_ID_Col = 1Const Point_X_Col = 2Const Point_Y_Col = 3Const Point_Z_Col = 4Const Line_ID_Col = 6Const Line_Point1_Col = 7Const Line_Point2_

4、Col = 8Const Mesh_ID_Col = 10Const Mesh_Line1_Col = 11Const Mesh_Line2_Col = 12Const Force_ID_Col = 14Const Force_M_Col = 15Const Force_N_Col = 16Const Force_Q_Col = 17Dim EXCEL As Object*Private Sub CreatePoint_CheckBox_Change()CreateLine_CheckBox.Value = CreatePoint_CheckBox.ValueCreateLine_CheckB

5、ox.Enabled = CreatePoint_CheckBox.ValueEnd SubPrivate Sub CreateLine_CheckBox_Change()CreateMesh_CheckBox.Value = CreateLine_CheckBox.ValueCreateMesh_CheckBox.Enabled = CreateLine_CheckBox.ValueEnd SubPrivate Sub ChooseFile_CommandButton_Click()On Error GoTo error_1Set EXCEL = CreateObject(EXCEL.App

6、lication, )Dim DataFileName As StringDataFileName = 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 HybridBo

7、dy 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.C

8、reateForce_N_CommandButton.Enabled = True MainForm_UserForm.CreateForce_Q_CommandButton.Enabled = True End IfEnd IfExit Suberror_1:EXCEL.QuitEnd SubPrivate Function Set_Cur_HybridBody() As HybridBodyOn Error GoTo error_1Dim partDocument1 As PartDocumentSet partDocument1 = CATIA.ActiveDocumentDim par

9、t1 As PartSet part1 = partDocument1.PartDim hybridShapeFactory1 As HybridShapeFactorySet hybridShapeFactory1 = part1.HybridShapeFactoryDim hybridBodies1 As HybridBodiesSet hybridBodies1 = part1.HybridBodiesDim hybridBody1 As HybridBodyDim temp_name As Stringtemp_name = MainForm_UserForm.ChooseFile_C

10、ommandButton.Captiontemp_name = StrConv(Mid(temp_name, InStrRev(temp_name, ) + 1), 1)k = 0For 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 IfNext NIf k 0 Then Msg

11、Box have same data file! hybridBody1.Name = DATA FROM EXCEL - + temp_name + ( + CStr(k) + )End IfSet hybridBody1 = hybridBodies1.Add()hybridBody1.Name = DATA FROM EXCEL - + temp_nameSet Set_Cur_HybridBody = hybridBody1Max = 1For n = 1 To hybridBodies1.Count Set hybridBody1 = hybridBodies1.Item(n) If

12、 (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 IfNext nExit Functionerror_1:EXCEL.QuitEnd FunctionPrivate Sub CreatePoint(Cur_hybridBody As HybridBody)On Error Go

13、To error_1Dim partDocument1 As PartDocumentSet partDocument1 = CATIA.ActiveDocumentDim part1 As PartSet part1 = partDocument1.PartDim hybridShapeFactory1 As HybridShapeFactorySet hybridShapeFactory1 = part1.HybridShapeFactoryDim hybridBodies1 As HybridBodiesSet hybridBodies1 = part1.HybridBodiesDim

14、hybridBody1 As HybridBodySet hybridBody1 = Cur_hybridBody.HybridBodies.Add()hybridBody1.Name = POINT DATADim i As IntegerDim ID As StringDim X As StringDim Y As StringDim Z As String Dim hybridShapePointCoord1 As HybridShapePointCoordFor i = Data_Start_Row To 1000 ID = EXCEL.cells(i, Point_ID_Col).V

15、alue 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) h

16、ybridBody1.AppendHybridShape hybridShapePointCoord1 hybridShapePointCoord1.Name = POINT. + IDNext ipart1.UpdateExit Suberror_1:EXCEL.QuitEnd SubPrivate Sub CreateLine(Cur_hybridBody As HybridBody)On Error GoTo error_1Dim partDocument1 As PartDocumentSet partDocument1 = CATIA.ActiveDocumentDim part1

17、As PartSet part1 = partDocument1.PartDim hybridShapeFactory1 As HybridShapeFactorySet hybridShapeFactory1 = part1.HybridShapeFactoryDim hybridBodies1 As HybridBodiesSet hybridBodies1 = part1.HybridBodiesDim hybridBody1 As HybridBodySet hybridBody1 = Cur_hybridBody.HybridBodies.Add()hybridBody1.Name

18、= LINE DATADim hybridShapes1 As HybridShapesSet hybridShapes1 = Cur_hybridBody.HybridBodies.Item(POINT DATA).HybridShapesDim i As IntegerDim ID As StringDim P1 As StringDim P2 As String Dim hybridShapePointCoord1 As HybridShapePointCoord Dim reference1 As Reference Dim hybridShapePointCoord2 As Hybr

19、idShapePointCoord Dim reference2 As Reference Dim hybridShapeLinePtPt1 As HybridShapeLinePtPt For i = Data_Start_Row To 1000 ID = EXCEL.cells(i, Line_ID_Col).Value P1 = EXCEL.cells(i, Line_Point1_Col).Value P2 = EXCEL.cells(i, Line_Point2_Col).Value If (ID = Or P1 = Or P2 = ) Then Exit For End If Di

20、m hybridShapePointCoord1 As HybridShapePointCoord Set hybridShapePointCoord1 = hybridShapes1.Item(POINT. + P1) Dim reference1 As Reference Set reference1 = part1.CreateReferenceFromObject(hybridShapePointCoord1) Dim hybridShapePointCoord2 As HybridShapePointCoord Set hybridShapePointCoord2 = hybridS

21、hapes1.Item(POINT. + P2) Dim reference2 As Reference Set reference2 = part1.CreateReferenceFromObject(hybridShapePointCoord2) Dim hybridShapeLinePtPt1 As HybridShapeLinePtPt Set hybridShapeLinePtPt1 = hybridShapeFactory1.AddNewLinePtPt(reference1, reference2) hybridBody1.AppendHybridShape hybridShap

22、eLinePtPt1 hybridShapeLinePtPt1.Name = LINE. + ID Next ipart1.UpdateExit Suberror_1:EXCEL.QuitEnd SubPrivate Sub CreateMesh(Cur_hybridBody As HybridBody)On Error GoTo error_1Dim partDocument1 As PartDocumentSet partDocument1 = CATIA.ActiveDocumentDim part1 As PartSet part1 = partDocument1.PartDim hy

23、bridShapeFactory1 As HybridShapeFactorySet hybridShapeFactory1 = part1.HybridShapeFactoryDim hybridBodies1 As HybridBodiesSet hybridBodies1 = part1.HybridBodiesDim hybridBody1 As HybridBodySet hybridBody1 = Cur_hybridBody.HybridBodies.Add()hybridBody1.Name = MESH DATADim hybridShapes1 As HybridShape

24、sSet hybridShapes1 = Cur_hybridBody.HybridBodies.Item(LINE DATA).HybridShapesDim i As IntegerDim ID As StringDim L1 As StringDim L2 As String Dim hybridShapeLinePtPt1 As HybridShapeLinePtPt Dim hybridShapeLinePtPt2 As HybridShapeLinePtPt Dim reference1 As Reference Dim reference2 As Reference Dim hy

25、bridShapeBlend1 As HybridShapeBlend For i = Data_Start_Row To 1000 ID = EXCEL.cells(i, Mesh_ID_Col).Value L1 = EXCEL.cells(i, Mesh_Line1_Col).Value L2 = EXCEL.cells(i, Mesh_Line2_Col).Value If (ID = Or L1 = Or L2 = ) Then Exit For End If Set hybridShapeBlend1 = hybridShapeFactory1.AddNewBlend() hybr

26、idShapeBlend1.Coupling = 1 Dim hybridShapeLinePtPt1 As HybridShapeLinePtPt Set hybridShapeLinePtPt1 = hybridShapes1.Item(LINE. + L1) Dim reference1 As Reference Set reference1 = part1.CreateReferenceFromObject(hybridShapeLinePtPt1) hybridShapeBlend1.SetCurve 1, reference1 hybridShapeBlend1.SetOrient

27、ation 1, 1 Dim hybridShapeLinePtPt2 As HybridShapeLinePtPt Set hybridShapeLinePtPt2 = hybridShapes1.Item(LINE. + L2) Dim reference2 As Reference Set reference2 = part1.CreateReferenceFromObject(hybridShapeLinePtPt2) Dim hybridShapeBlend1 As HybridShapeBlend hybridShapeBlend1.SetCurve 2, reference2 h

28、ybridShapeBlend1.SetOrientation 2, 1 hybridShapeBlend1.SmoothAngleThresholdActivity = False hybridShapeBlend1.SmoothDeviationActivity = False hybridBody1.AppendHybridShape hybridShapeBlend1 hybridShapeBlend1.Name = MESH. + ID Next ipart1.UpdateExit Suberror_1:EXCEL.QuitEnd SubPrivate Sub CreateForce_M_CommandButton_Click()On Error GoTo error_1Dim partDocument1 As PartDocumentSet partDocument1 = CATIA.ActiveDocumentDim part1 As PartSet part1 = partDocument1.PartDim hybridShapeFactory1 As HybridShapeFactorySet hybridShapeF