'点数据是基本数据，线由点组成，面又由线组成，因此只有填写了点数据后才能添加线数据，
'面与线类似。本程序中默认的扩展数据为关键点处的内力数据，其ID应该与点数据的ID一致。
'下表中具体含义：ID—数据编号，（X，Y，Z）—点数据坐标值，（P1，P2）—组成线的点ID，
'（L1，L2）—组成面的线ID，（M，N，Q）—关键点处弯矩、轴力、剪力的数值。
'程序界面如下：                                   

http://img.blog.163.com/photo/Yor1hGdQwsnEOUN1LqVQfQ==/2577466361739995309.jpg
'注意：表格中的数据区可以为空，每一类数据中只要有一行中出现空值，即认为该
'      类数据结束，其后的数据不再读取。本程序启动一次读入一张表格后，其点、线、面
'      数据不应该被改变。但其内力（M，N，Q）的数值允许改变，保存表格后，可以选择更
'      新内力图（如果程序窗口已经关闭，重新启动后不要选中“创建点”后重新打开文件）
'      但一定要保证CATIA中该表格数据所在的几何图形集名称与表格对应，通常默认即可。
'      如果数据表中的点、线、面数据有变，即认为这是一张新的数据表，应该换一个新的文
'      件名并作为新的数据表重新导入，若不改名则请确保当前PART根结点下没有与其文件名
'      相同的几何图形集（此处几何图形集的命名方式为：DATA FORM EXCEL - 文件名）。
'      另外，内力关键点必须在同一平面内，且不在同一直线上。
'默认的EXCLE表格中数据格式如下：
http://img.blog.163.com/photo/S2SKtB5bEnA_2t_fphXomQ==/294985775593319210.jpg
'表格可以扩展，具体格式也可能改变，此时须改变下列常数的值，以保证与表格中的一致
'程序中使用的有关常数定义：
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
    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 i

part1.Update

Exit Sub
error_1:
EXCEL.Quit
End Sub

Private Sub CreateMesh(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 = "MESH DATA"

Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = Cur_hybridBody.HybridBodies.Item("LINE DATA").HybridShapes

Dim i As Integer
Dim ID As String
Dim L1 As String
Dim 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 i

part1.Update

Exit Sub
error_1:
EXCEL.Quit
End Sub

 

Private Sub CreateForce_M_CommandButton_Click()

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)
Set hybridBody1 = hybridBodies1.Item("DATA FROM EXCEL - " + temp_name)

Dim Cur_hybridBody As HybridBody
'******************************************
temp_name = "FORCE-M"
k = 0
For 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 If
Next t
If k > 0 Then
    Cur_hybridBody.Name = temp_name + "(" + CStr(k) + ")"
End If
'*******************************************
Set Cur_hybridBody = hybridBody1.HybridBodies.Add()
Cur_hybridBody.Name = temp_name

Dim Ref_hybridBody As HybridBody
Set Ref_hybridBody = hybridBody1.HybridBodies.Item("POINT DATA")
CreateSpline Cur_hybridBody, Ref_hybridBody

Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = Ref_hybridBody.HybridShapes
Dim i As Integer
Dim ID As String
Dim 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 i

Cur_hybridBody.AppendHybridShape hybridShapeSpline_M
hybridShapeSpline_M.Name = "MIDDLE SPLINE"
part1.Update

Exit Sub
error_1:
EXCEL.Quit

End Sub

 

Private Sub CreateForce_N_CommandButton_Click()

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)
Set hybridBody1 = hybridBodies1.Item("DATA FROM EXCEL - " + temp_name)

Dim Cur_hybridBody As HybridBody
'******************************************
temp_name = "FORCE-N"
k = 0
For 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 If
Next t
If k > 0 Then
    Cur_hybridBody.Name = temp_name + "(" + CStr(k) + ")"
End If
'*******************************************
Set Cur_hybridBody = hybridBody1.HybridBodies.Add()
Cur_hybridBody.Name = temp_name

Dim Ref_hybridBody As HybridBody
Set Ref_hybridBody = hybridBody1.HybridBodies.Item("POINT DATA")
CreateSpline Cur_hybridBody, Ref_hybridBody

Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = Ref_hybridBody.HybridShapes
Dim i As Integer
Dim ID As String
Dim 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 i

Cur_hybridBody.AppendHybridShape hybridShapeSpline_N
hybridShapeSpline_N.Name = "MIDDLE SPLINE"
part1.Update

Exit Sub
error_1:
EXCEL.Quit

End Sub

Private Sub CreateForce_Q_CommandButton_Click()
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)
Set hybridBody1 = hybridBodies1.Item("DATA FROM EXCEL - " + temp_name)

Dim Cur_hybridBody As HybridBody
'******************************************
temp_name = "FORCE-Q"
k = 0
For 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 If
Next t
If k > 0 Then
    Cur_hybridBody.Name = temp_name + "(" + CStr(k) + ")"
End If
'*******************************************
Set Cur_hybridBody = hybridBody1.HybridBodies.Add()
Cur_hybridBody.Name = temp_name

Dim Ref_hybridBody As HybridBody
Set Ref_hybridBody = hybridBody1.HybridBodies.Item("POINT DATA")
CreateSpline Cur_hybridBody, Ref_hybridBody

Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = Ref_hybridBody.HybridShapes
Dim i As Integer
Dim ID As String
Dim Q 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_Q As HybridShapeSpline
    Set hybridShapeSpline_Q = hybridShapeFactory1.AddNewSpline()
    hybridShapeSpline_Q.SetSplineType 0
    hybridShapeSpline_Q.SetClosing 0
    
For i = Data_Start_Row To 1000

    ID = EXCEL.cells(i, Force_ID_Col).Value
    Q = EXCEL.cells(i, Force_Q_Col).Value
    If (ID = "" Or Q = "") Then
        Exit For
    End If
    If Q = 0 Then Q = 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, Q, 0#, 90#, False)

    Cur_hybridBody.AppendHybridShape hybridShapeLineAngle1
    hybridShapeLineAngle1.Name = "Q-VALUE." + ID
    'part1.Update
    'Dim reference2 As Reference
    Set reference2 = part1.CreateReferenceFromObject(hybridShapeLineAngle1)
    If Q > 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 = "Q-POINT." + ID
    Set reference2 = part1.CreateReferenceFromObject(hybridShapePointOnCurve1)
    hybridShapeSpline_Q.AddPointWithConstraintExplicit reference2, Nothing, -1#, 1, Nothing, 0#
Next i

Cur_hybridBody.AppendHybridShape hybridShapeSpline_Q
hybridShapeSpline_Q.Name = "MIDDLE SPLINE"
part1.Update

Exit Sub
error_1:
EXCEL.Quit

End Sub

Private Sub CreateSpline(Cur_hybridBody As HybridBody, Ref_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

Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = Ref_hybridBody.HybridShapes

Dim i As Integer
Dim ID As String

    Dim hybridShapePointCoord1 As HybridShapePointCoord
    Dim reference1 As Reference
    
    Dim hybridShapeSpline1 As HybridShapeSpline
    Set hybridShapeSpline1 = hybridShapeFactory1.AddNewSpline()
    hybridShapeSpline1.SetSplineType 0
    hybridShapeSpline1.SetClosing 0

For i = Data_Start_Row To 1000

    ID = EXCEL.cells(i, Force_ID_Col).Value
    If (ID = "") Then
        Exit For
    End If

    'Dim hybridShapePointCoord1 As HybridShapePointCoord
    Set hybridShapePointCoord1 = hybridShapes1.Item("POINT." + ID)
 
    'Dim reference1 As Reference
    Set reference1 = part1.CreateReferenceFromObject(hybridShapePointCoord1)
    hybridShapeSpline1.AddPointWithConstraintExplicit reference1, Nothing, -1#, 1, Nothing, 0#        
Next i
hybridBody1.AppendHybridShape hybridShapeSpline1
hybridShapeSpline1.Name = "MIDDLE SPLINE"

part1.Update

Exit Sub
error_1:
EXCEL.Quit
End Sub

Private Sub UserForm_Terminate()

On Error Resume Next
EXCEL.Quit

End Sub
'************程序中存在相似函数并未简化<nuaa_wjz 2007-02-28>********

'*************通过运行"工具"－》"宏"得到结果如下：

http://img.blog.163.com/photo/Soa8OCK0jFSWEhBoiTtOMA==/3967108321760452014.jpg