CATIA读取EXCEL.doc

在CATIA中利用VBA读取EXCEL中的数据本程序可以把EXCEL表格中按一定格式存储的点、线、面等数据读取到CATIA并创建相应的对象点数据是基本数据，线由点组成，面又由线组成，因此只有填写了点数据后才能添加线数据，面与线类似。本程序中默认的扩展数据为关键点处的内力数据，其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 = 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_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_CheckBox.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.Application, )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 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 IfEnd IfExit Suberror_1:EXCEL.QuitEnd SubPrivate Function Set_Cur_HybridBody() As HybridBodyOn Error GoTo 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 hybridBody1 As HybridBodyDim temp_name As Stringtemp_name = MainForm_UserForm.ChooseFile_CommandButton.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 MsgBox 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 (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 GoTo 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 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).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. + 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 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 = 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 HybridShapePointCoord 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 Dim hybridShapePointCoord1 As HybridShapePointCoord Set hybridShapePointCoord1 = hybridShapes1.Item(POINT. + P1) Dim reference1 As Reference Set reference1 = part1.CreateReferenceFromObject(hybridShapePointCoord1) Dim hybridShapePointCoord2 As HybridShapePointCoord Set hybridShapePointCoord2 = hybridShapes1.Item(POINT. + P2) Dim reference2 As Reference Set reference2 = part1.CreateReferenceFromObject(hybridShapePointCoord2) Dim hybridShapeLinePtPt1 As HybridShapeLinePtPt Set hybridShapeLinePtPt1 = hybridShapeFactory1.AddNewLinePtPt(reference1, reference2) hybridBody1.AppendHybridShape hybridShapeLinePtPt1 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 hybridShapeFactory1 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 HybridShapesSet 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 hybridShapeBlend1 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() hybridShapeBlend1.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.SetOrientation 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 hybridShapeBlend1.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 hybridShapeFactory1 = part1.HybridShapeFactoryDim hybridBodies1 As HybridBodiesSet hybridBodies1 = part1.HybridBodiesDim hybridBody1 As HybridBodyDim temp_name As Stringtemp_name = MainForm_UserForm.ChooseFile_CommandButton.Captiontemp_name = StrConv(Mid(temp_name, InStrRev(temp_name, ) + 1), 1)Set hybridBody1 = hybridBodies1.Item(DATA FROM EXCEL - + temp_name)Dim Cur_hybridBody As HybridBody*temp_name = FORCE-Mk = 0For t = 1 To hybridBody1.HybridBodies.Count Set Cur_hybridBody = hybridBody1.HybridBodies.Item(t) If (Left(Cur_hybridBody.Name, Len(temp_name) = temp_name) Then k = k + 1 End IfNext tIf k 0 Then Cur_hybridBody.Name = temp_name + ( + CStr(k) + )End If*Set Cur_hybridBody = hybridBody1.HybridBodies.Add()Cur_hybridBody.Name = temp_nameDim Ref_hybridBody As HybridBodySet Ref_hybridBody = hybridBody1.HybridBodies.Item(POINT DATA)CreateSpline Cur_hybridBody, Ref_hybridBodyDim hybridShapes1 As HybridShapesSet hybridShapes1 = Ref_hybridBody.HybridShapesDim i As IntegerDim ID As StringDim M As String Dim hybridShapePointCoord1 As HybridShapePointCoord Dim hybridShapeSpline1 As HybridShapeSpline Set hybridShapeSpline1 = Cur_hybridBody.HybridShapes.Item(MIDDLE SPLINE) Dim reference1 As Reference Set reference1 = part1.CreateReferenceFromObject(hybridShapeSpline1) Dim reference2 As Reference Dim hybridShapeLineAngle1 As HybridShapeLineAngle Dim hybridShapePointOnCurve1 As HybridShapePointOnCurve Dim hybridShapeSpline_M As HybridShapeSpline Set hybridShapeSpline_M = hybridShapeFactory1.AddNewSpline() hybridShapeSpline_M.SetSplineType 0 hybridShapeSpline_M.SetClosing 0 For i = Data_Start_Row To 1000 ID = EXCEL.cells(i, Force_ID_Col).Value M = EXCEL.cells(i, Force_M_Col).Value If (ID = Or M = ) Then Exit For End If If M = 0 Then M = 0.001 Dim hybridShapePointCoord1 As HybridShapePointCoord Set hybridShapePointCoord1 = hybridShapes1.Item(POINT. + ID) Dim reference As Reference Set reference2 = part1.CreateReferenceFromObject(hybridShapePointCoord1) Dim hybridShapeLineAngle1 As HybridShapeLineAngle Set hybridShapeLineAngle1 = hybridShapeFactory1.AddNewLineAngle(reference1, Nothing, reference2, False, M, 0#, 90#, False) Cur_hybridBody.AppendHybridShape hybridShapeLineAngle1 hybridShapeLineAngle1.Name = M-VALUE. + ID part1.Update Dim reference2 As Reference Set reference2 = part1.CreateReferenceFromObject(hybridShapeLineAngle1) If M 0 Then Set hybridShapePointOnCurve1 = hybridShapeFactory1.AddNewPointOnCurveFromPercent(reference2, 1#, False) Else Set hybridShapePointOnCurve1 = hybridShapeFactory1.AddNewPointOnCurveFromPercent(reference2, 0#, False) End If Cur_hybridBody.AppendHybridShape hybridShapePointOnCurve1 hybridShapePointOnCurve1.Name = M-POINT. + ID Set reference2 = part1.CreateReferenceFromObject(hybridShapePointOnCurve1) hybridShapeSpline_M.AddPointWithConstraintExplicit reference2, Nothing, -1#, 1, Nothing, 0#Next iCur_hybridBody.AppendHybridShape hybridShapeSpline_MhybridShapeSpline_M.Name = MIDDLE SPLINEpart1.UpdateExit Suberror_1:EXCEL.QuitEnd SubPrivate Sub CreateForce_N_CommandButton_Click()On Error GoTo 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 hybridBody1 As HybridBodyDim temp_name As Stringtemp_name = MainForm_UserForm.ChooseFile_CommandButton.Captiontemp_name = StrConv(Mid(temp_name, InStrRev(temp_name, ) + 1), 1)Set hybridBody1 = hybridBodies1.Item(DATA FROM EXCEL - + temp_name)Dim Cur_hybridBody As HybridBody*temp_name = FORCE-Nk = 0For t = 1 To hybridBody1.HybridBodies.Count Set Cur_hybridBody = hybridBody1.HybridBodies.Item(t) If (Left(Cur_hybridBody.Name, Len(temp_name) = temp_name) Then k = k + 1 End IfNext tIf k 0 Then Cur_hybridBody.Name = temp_name + ( + CStr(k) + )End If*Set Cur_hybridBody = hybridBody1.HybridBodies.Add()Cur_hybridBody.Name = temp_nameDim Ref_hybridBody As HybridBodySet Ref_hybridBody = hybridBody1.HybridBodies.Item(POINT DATA)CreateSpline Cur_hybridBody, Ref_hybridBodyDim hybridShapes1 As HybridShapesSet hybridShapes1 = Ref_hybridBody.HybridShapesDim i As IntegerDim ID As StringDim N As String Dim hybridShapePointCoord1 As HybridShapePointCoord Dim hybridShapeSpline1 As HybridShapeSpline Set hybridShapeSpline1 = Cur_hybridBody.HybridShapes.Item(MIDDLE SPLINE) Dim reference1 As Reference Set reference1 = part1.CreateReferenceFromObject(hybridShapeSpline1) Dim reference2 As Reference Dim hybridShapeLineAngle1 As HybridShapeLineAngle Dim hybridShapePointOnCurve1 As HybridShapePointOnCurve Dim hybridShapeSpline_N As HybridShapeSpline Set hybridShapeSpline_N = hybridShapeFactory1.AddNewSpline() hybridShapeSpline_N.SetSplineType 0 hybridShapeSpline_N.SetClosing 0 For i = Data_Start_Row To 1000 ID = EXCEL.cells(i, Force_ID_Col).Value N = EXCEL.cells(i, Force_N_Col).Value If (ID = Or N = ) Then Exit For End If If N = 0 Then N = 0.001 Dim hybridShapePointCoord1 As HybridShapePointCoord Set hybridShapePointCoord1 = hybridShapes1.Item(POINT. + ID) Dim reference As Reference Set reference2 = part1.CreateReferenceFromObject(hybridShapePointCoord1) Dim hybridShapeLineAngle1 As HybridShapeLineAngle Set hybridShapeLineAngle1 = hybridShapeFactory1.AddNewLineAngle(reference1, Nothing, reference2, False, N, 0#, 90#, False) Cur_hybridBody.AppendHybridShape hybridShapeLineAngle1 hybridShapeLineAngle1.Name = N-VALUE. + ID part1.Update Dim reference2 As Reference Set reference2 = part1.CreateReferenceFromObject(hybridShapeLineAngle1) If N 0 Then Set hybridShapePointOnCurve1 = hybridShapeFactory1.AddNewPointOnCurveFromPercent(reference2, 1#, False) Else Set hybridShapePointOnCurve1 = hybridShapeFactory1.AddNewPointOnCurveFromPercent(reference2, 0#, False) End If Cur_hybridBody.AppendHybridShape hybridShapePointOnCurve1 hybridShapePointOnCurve1.Name = N-POINT. + ID Set reference2 = part1.CreateReferenceFromObject(hybridShapePointOnCurve1) hybridShapeSpline_N.AddPointWithConstraintExplicit reference2, Nothing, -1#, 1, Nothing, 0#Next iCur_hybridBody.AppendHybridShape hybridShapeSpline_NhybridShapeSpline_N.Name = MIDDLE SPLINEpart1.UpdateExit Suberror_1:EXCEL.QuitEnd SubPrivate Sub CreateForce_Q_CommandButton_Click()On Error GoTo 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 hybridBody1 As HybridBodyDim temp_name As Stringtemp_name = MainForm_UserForm.ChooseFile_CommandButton.Captiontemp_name = StrConv(Mid(temp_name, InStrRev(temp_name, ) + 1), 1)Set hybridBody1 = hybridBodies1.Item(DATA FROM EXCEL - + temp_name)Dim Cur_hybridBody As HybridBody*temp_name = FORCE-Qk = 0For t = 1 To hybridBody1.HybridBodies.Count Set Cur_hybridBody = hybridBody1.HybridBodies.Item(t) If (Left(Cur_hybridBody.Name, Len(temp_name) = temp_name) Then k = k + 1 End IfNext tIf k 0 Then Cur_hybridBody.Name = temp_name