Code:
Sub CATMain() Dim oActDoc As Document
If CATIA.Documents.Count = 0 Then
MsgBox ("Kein Dokument geöffnet!")
Exit Sub
End If
Set oActDoc = CATIA.ActiveDocument
If TypeName(oActDoc) <> "PartDocument" Then
MsgBox ("Kein CATPart geöffnet!")
Exit Sub
End If
Dim oPart As Part
Set oPart = oActDoc.Part
Dim body1 As Body
Set body1 = oPart.MainBody
Dim sketches1 As Sketches
Set sketches1 = body1.Sketches
Dim reference1 As Reference
Set reference1 = oPart.OriginElements.PlaneXY
Dim sketch1 'As Sketch
Set sketch1 = sketches1.Add(reference1)
Dim arrayOfVariantOfDouble1(8)
arrayOfVariantOfDouble1(0) = 0#
arrayOfVariantOfDouble1(1) = 0#
arrayOfVariantOfDouble1(2) = 0#
arrayOfVariantOfDouble1(3) = 1#
arrayOfVariantOfDouble1(4) = 0#
arrayOfVariantOfDouble1(5) = 0#
arrayOfVariantOfDouble1(6) = 0#
arrayOfVariantOfDouble1(7) = 1#
arrayOfVariantOfDouble1(8) = 0#
sketch1.SetAbsoluteAxisData arrayOfVariantOfDouble1
oPart.InWorkObject = sketch1
Dim factory2D1 As Factory2D
Set factory2D1 = sketch1.OpenEdition()
Dim o2DFactory 'As Factory2D
Set o2DFactory = sketch1.Factory2D
Dim oPoint2D As Point2D
Dim aoPoints()
ReDim aoPoints(20)
Dim iPointsCount As Integer
iPointsCount = 0
Dim oFile As File
Set oFile = CATIA.FileSystem.GetFile("d:\input.txt")
Dim oTextStream As TextStream
Set oTextStream = oFile.OpenAsTextStream("ForReading")
Dim sLine As String
Dim x As Double
Dim y As Double
Dim z As Double
Dim f As Integer
Dim g As Integer
'Bei mir zickt CATIA und will nicht am Ende der Datei aufhören
Do Until oTextStream.AtEndOfStream
sLine = oTextStream.ReadLine
sLine = Trim(sLine)
If sLine <> "" Then
f = InStr(1, sLine, ";")
'in der Replace Dezimaltrennzeichen ggf. tauschen
x = CDbl(Replace(Left(sLine, f - 1), ".", ","))
g = InStr(f + 1, sLine, ";")
y = CDbl(Replace(Mid(sLine, f + 1, g - f - 1), ".", ","))
f = InStr(g + 1, sLine, ";")
z = CDbl(Replace(Mid(sLine, g + 1, f - g - 1), ".", ","))
Set oPoint2D = o2DFactory.CreatePoint(x, y)
Set aoPoints(iPointsCount) = oPoint2D
iPointsCount = iPointsCount + 1
If iPointsCount <= UBound(aoPoints) Then
ReDim Preserve aoPoints(iPointsCount + 20)
End If
Else
'Da CATIA bei der Dateiende zickt, anbei ein Workaroung
Exit Do
End If
Loop
ReDim Preserve aoPoints(iPointsCount - 1)
oPart.Update
oTextStream.Close
Dim oSpline As Spline2D
Set oSpline = o2DFactory.CreateSpline(aoPoints)
sketch1.CloseEdition
oPart.Update
End Sub