在CATIA中利用VBA读取EXCEL中的数据.docx
《在CATIA中利用VBA读取EXCEL中的数据.docx》由会员分享,可在线阅读,更多相关《在CATIA中利用VBA读取EXCEL中的数据.docx(21页珍藏版)》请在冰点文库上搜索。
在CATIA中利用VBA读取EXCEL中的数据
在CATIA中利用VBA读取EXCEL中的数据
2008-02-2823:
10:
49| 分类:
记事本| 标签:
|字号大中小 订阅
'*********************************************************************
'本程序可以把EXCEL表格中按一定格式存储的点、线、面等数据读取到CATIA并创建相应的对象
'点数据是基本数据,线由点组成,面又由线组成,因此只有填写了点数据后才能添加线数据,
'面与线类似。
本程序中默认的扩展数据为关键点处的内力数据,其ID应该与点数据的ID一致。
'下表中具体含义:
ID—数据编号,(X,Y,Z)—点数据坐标值,(P1,P2)—组成线的点ID,
'(L1,L2)—组成面的线ID,(M,N,Q)—关键点处弯矩、轴力、剪力的数值。
'程序界面如下:
'注意:
表格中的数据区可以为空,每一类数据中只要有一行中出现空值,即认为该
' 类数据结束,其后的数据不再读取。
本程序启动一次读入一张表格后,其点、线、面
' 数据不应该被改变。
但其内力(M,N,Q)的数值允许改变,保存表格后,可以选择更
' 新内力图(如果程序窗口已经关闭,重新启动后不要选中“创建点”后重新打开文件)
' 但一定要保证CATIA中该表格数据所在的几何图形集名称与表格对应,通常默认即可。
' 如果数据表中的点、线、面数据有变,即认为这是一张新的数据表,应该换一个新的文
' 件名并作为新的数据表重新导入,若不改名则请确保当前PART根结点下没有与其文件名
' 相同的几何图形集(此处几何图形集的命名方式为:
DATAFORMEXCEL-文件名)。
' 另外,内力关键点必须在同一平面内,且不在同一直线上。
'默认的EXCLE表格中数据格式如下:
'表格可以扩展,具体格式也可能改变,此时须改变下列常数的值,以保证与表格中的一致
'程序中使用的有关常数定义:
ConstData_Start_Row=3
ConstPoint_ID_Col=1
ConstPoint_X_Col=2
ConstPoint_Y_Col=3
ConstPoint_Z_Col=4
ConstLine_ID_Col=6
ConstLine_Point1_Col=7
ConstLine_Point2_Col=8
ConstMesh_ID_Col=10
ConstMesh_Line1_Col=11
ConstMesh_Line2_Col=12
ConstForce_ID_Col=14
ConstForce_M_Col=15
ConstForce_N_Col=16
ConstForce_Q_Col=17
DimEXCELAsObject
'*************************************
PrivateSubCreatePoint_CheckBox_Change()
CreateLine_CheckBox.Value=CreatePoint_CheckBox.Value
CreateLine_CheckBox.Enabled=CreatePoint_CheckBox.Value
EndSub
PrivateSubCreateLine_CheckBox_Change()
CreateMesh_CheckBox.Value=CreateLine_CheckBox.Value
CreateMesh_CheckBox.Enabled=CreateLine_CheckBox.Value
EndSub
PrivateSubChooseFile_CommandButton_Click()
OnErrorGoToerror_1
SetEXCEL=CreateObject("EXCEL.Application","")
DimDataFileNameAsString
DataFileName=EXCEL.GetOpenFilename("EXCELFiles(*.xls),*.xls")
IfDataFileName<>"False"Then
EXCEL.workbooks.OpenDataFileName
MainForm_UserForm.ChooseFile_CommandButton.Caption=DataFileName
IfCreatePoint_CheckBox.Value=TrueThen
DimCur_hybridBodyAsHybridBody
SetCur_hybridBody=Set_Cur_HybridBody()
CreatePointCur_hybridBody
IfCreateLine_CheckBox.Value=TrueThen
CreateLineCur_hybridBody
IfCreateMesh_CheckBox.Value=TrueThen
CreateMeshCur_hybridBody
EndIf
EndIf
MainForm_UserForm.CreateForce_M_CommandButton.Enabled=True
MainForm_UserForm.CreateForce_N_CommandButton.Enabled=True
MainForm_UserForm.CreateForce_Q_CommandButton.Enabled=True
EndIf
EndIf
ExitSub
error_1:
EXCEL.Quit
EndSub
PrivateFunctionSet_Cur_HybridBody()AsHybridBody
OnErrorGoToerror_1
DimpartDocument1AsPartDocument
SetpartDocument1=CATIA.ActiveDocument
Dimpart1AsPart
Setpart1=partDocument1.Part
DimhybridShapeFactory1AsHybridShapeFactory
SethybridShapeFactory1=part1.HybridShapeFactory
DimhybridBodies1AsHybridBodies
SethybridBodies1=part1.HybridBodies
DimhybridBody1AsHybridBody
Dimtemp_nameAsString
temp_name=MainForm_UserForm.ChooseFile_CommandButton.Caption
temp_name=StrConv(Mid(temp_name,InStrRev(temp_name,"\")+1),1)
k=0
ForN=1TohybridBodies1.Count
SethybridBody1=hybridBodies1.Item(N)
If(Left(hybridBody1.Name,Len("DATAFROMEXCEL-"+temp_name))="DATAFROMEXCEL-"+temp_name)Then
k=k+1
EndIf
NextN
Ifk>0Then
'MsgBox"havesamedatafile!
"
hybridBody1.Name="DATAFROMEXCEL-"+temp_name+"("+CStr(k)+")"
EndIf
SethybridBody1=hybridBodies1.Add()
hybridBody1.Name="DATAFROMEXCEL-"+temp_name
SetSet_Cur_HybridBody=hybridBody1
'Max=1
'Forn=1TohybridBodies1.Count
' SethybridBody1=hybridBodies1.Item(n)
' If(Left(hybridBody1.Name,InStrRev(hybridBody1.Name,"."))="DATAFROMEXCEL.")Then
' m=CInt(Mid(hybridBody1.Name,InStrRev(hybridBody1.Name,".")+1))
' Ifm>=MaxThen
' Max=m+1
' EndIf
' EndIf
'Nextn
ExitFunction
error_1:
EXCEL.Quit
EndFunction
PrivateSubCreatePoint(Cur_hybridBodyAsHybridBody)
'OnErrorGoToerror_1
DimpartDocument1AsPartDocument
SetpartDocument1=CATIA.ActiveDocument
Dimpart1AsPart
Setpart1=partDocument1.Part
DimhybridShapeFactory1AsHybridShapeFactory
SethybridShapeFactory1=part1.HybridShapeFactory
DimhybridBodies1AsHybridBodies
SethybridBodies1=part1.HybridBodies
DimhybridBody1AsHybridBody
SethybridBody1=Cur_hybridBody.HybridBodies.Add()
hybridBody1.Name="POINTDATA"
DimiAsInteger
DimIDAsString
DimXAsString
DimYAsString
DimZAsString
DimhybridShapePointCoord1AsHybridShapePointCoord
Fori=Data_Start_RowTo1000
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=""OrX=""OrY=""OrZ="")Then
ExitFor
EndIf
'DimhybridShapePointCoord1AsHybridShapePointCoord
SethybridShapePointCoord1=hybridShapeFactory1.AddNewPointCoord(X,Y,Z)
hybridBody1.AppendHybridShapehybridShapePointCoord1
hybridShapePointCoord1.Name="POINT."+ID
Nexti
part1.Update
ExitSub
error_1:
EXCEL.Quit
EndSub
PrivateSubCreateLine(Cur_hybridBodyAsHybridBody)
'OnErrorGoToerror_1
DimpartDocument1AsPartDocument
SetpartDocument1=CATIA.ActiveDocument
Dimpart1AsPart
Setpart1=partDocument1.Part
DimhybridShapeFactory1AsHybridShapeFactory
SethybridShapeFactory1=part1.HybridShapeFactory
DimhybridBodies1AsHybridBodies
SethybridBodies1=part1.HybridBodies
DimhybridBody1AsHybridBody
SethybridBody1=Cur_hybridBody.HybridBodies.Add()
hybridBody1.Name="LINEDATA"
DimhybridShapes1AsHybridShapes
SethybridShapes1=Cur_hybridBody.HybridBodies.Item("POINTDATA").HybridShapes
DimiAsInteger
DimIDAsString
DimP1AsString
DimP2AsString
DimhybridShapePointCoord1AsHybridShapePointCoord
Dimreference1AsReference
DimhybridShapePointCoord2AsHybridShapePointCoord
Dimreference2AsReference
DimhybridShapeLinePtPt1AsHybridShapeLinePtPt
Fori=Data_Start_RowTo1000
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=""OrP1=""OrP2="")Then
ExitFor
EndIf
'DimhybridShapePointCoord1AsHybridShapePointCoord
SethybridShapePointCoord1=hybridShapes1.Item("POINT."+P1)
'Dimreference1AsReference
Setreference1=part1.CreateReferenceFromObject(hybridShapePointCoord1)
'DimhybridShapePointCoord2AsHybridShapePointCoord
SethybridShapePointCoord2=hybridShapes1.Item("POINT."+P2)
'Dimreference2AsReference
Setreference2=part1.CreateReferenceFromObject(hybridShapePointCoord2)
'DimhybridShapeLinePtPt1AsHybridShapeLinePtPt
SethybridShapeLinePtPt1=hybridShapeFactory1.AddNewLinePtPt(reference1,reference2)
hybridBody1.AppendHybridShapehybridShapeLinePtPt1
hybridShapeLinePtPt1.Name="LINE."+ID
Nexti
part1.Update
ExitSub
error_1:
EXCEL.Quit
EndSub
PrivateSubCreateMesh(Cur_hybridBodyAsHybridBody)
OnErrorGoToerror_1
DimpartDocument1AsPartDocument
SetpartDocument1=CATIA.ActiveDocument
Dimpart1AsPart
Setpart1=partDocument1.Part
DimhybridShapeFactory1AsHybridShapeFactory
SethybridShapeFactory1=part1.HybridShapeFactory
DimhybridBodies1AsHybridBodies
SethybridBodies1=part1.HybridBodies
DimhybridBody1AsHybridBody
SethybridBody1=Cur_hybridBody.HybridBodies.Add()
hybridBody1.Name="MESHDATA"
DimhybridShapes1AsHybridShapes
SethybridShapes1=Cur_hybridBody.HybridBodies.Item("LINEDATA").HybridShapes
DimiAsInteger
DimIDAsString
DimL1AsString
DimL2AsString
DimhybridShapeLinePtPt1AsHybridShapeLinePtPt
DimhybridShapeLinePtPt2AsHybridShapeLinePtPt
Dimreference1AsReference
Dimreference2AsReference
DimhybridShapeBlend1AsHybridShapeBlend
Fori=Data_Start_RowTo1000
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=""OrL1=""OrL2="")Then
ExitFor
EndIf
SethybridShapeBlend1=hybridShapeFactory1.AddNewBlend()
hybridShapeBlend1.Coupling=1
'DimhybridShapeLinePtPt1AsHybridShapeLinePtPt
SethybridShapeLinePtPt1=hybridShapes1.Item("LINE."+L1)
'Dimreference1AsReference
Setreference1=part1.CreateReferenceFromObject(hybridShapeLinePtPt1)
hybridShapeBlend1.SetCurve1,reference1
hybridShapeBlend1.SetOrientation1,1
'DimhybridShapeLinePtPt2AsHybridShapeLinePtPt
SethybridShapeLinePtPt2=hybridShapes1.Item("LINE."+L2)
'Dimreference2AsReference
Setreference2=part1.CreateReferenceFromObject(hybridShapeLinePtPt2)
'DimhybridShapeBlend1AsHybridShapeBlend
hybridShapeBlend1.SetCurve2,reference2
hybridShapeBlend1.SetOrientation2,1
hybridShapeBlend1.SmoothAngleThresholdActivity=False
hybridShapeBlend1.SmoothDeviationActivity=False
hybridBody1.AppendHybridShapehybridShapeBlend1
hybridShapeBlend1.Name="MESH."+ID
Nexti
part1.Update
ExitSub
error_1:
EXCEL.Quit
EndSub
PrivateSubCreateForce_M_CommandButton_Click()
OnErrorGoToerror_1
DimpartDocument1AsPartDocument
SetpartDocument1=CATIA.ActiveDocument
Dimpart1AsPart
Setpart1=partDocument1.Part
DimhybridShapeFactory1AsHybridShapeFactory
SethybridShapeF