在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
升级会员 