Code:
Sub CATMain()' Fehlerroutine --------------------------------------------
On Error Resume Next
CATIA.DisplayFileAlerts = False
Set activedoc = CATIA.ActiveDocument
If Err.Number <> 0 Then
MsgBox "es ist kein Dokument geöffnet", 16
Exit Sub
End If
Set activedoc = CATIA.ActiveDocument
If (Right(activedoc.Name, 7) <> "CATPart" And Right(activedoc.Name, 10) <> "CATProduct") Then
MsgBox "Aktives Dokument ist kein Bauteil oder keine Baugruppe", 16
Exit Sub
End If
' Excel öffnen --------------------------------------------
Dim Excel As application
Dim WB
Dim WS
Set WB = GetObject("u:\aufgabe_Punkt.xls")
WB.application.Visible = True
WB.Parent.Windows(1).Visible = True
Set WS = WB.Worksheets.Item(1) ' Tabelle holen
' aktives part holen --------------------------------------------
Set Part1 = CATIA.ActiveDocument.Part
Set partDocument1 = CATIA.ActiveDocument
Set HybShapeFac = Part1.HybridShapeFactory 'factory zu erstellen der Punkte
Set HKoerper = CATIA.ActiveDocument.Part.HybridBodies 'hauptkörper holen zum einfügen der Punkte
Set measurement_points = HKoerper.Add 'Geoset einfügen
measurement_points.Name = "Messpunkte" 'benennen
' Exceltabelle ablesen --------------------------------------------
nRow = 2 'ab Zeile 2 Zeile der Tabelle einlesen
Do 'lesen bis EOF
' Spalte 1 = Name // Spalte 2,3,4 = Werte
Element = (WS.Cells(nRow, 1).Value)
XCoord = CDbl(WS.Cells(nRow, 2).Value)
YCoord = CDbl(WS.Cells(nRow, 3).Value)
ZCoord = CDbl(WS.Cells(nRow, 4).Value)
' Punkte eintragen --------------------------------------------
Set hybridShapeFactory1 = Part1.HybridShapeFactory
Set hybridShapePointCoord1 = hybridShapeFactory1.AddNewPointCoord(XCoord, YCoord, ZCoord)
measurement_points.AppendHybridShape hybridShapePointCoord1 ' Punkt einfügen
hybridShapePointCoord1.Name = Element ' Punkt benennen
nRow = nRow + 1 ' Zeile hochzählen
Loop While (WS.Cells(nRow, 2).Text <> "") ' Schleife verlassen, wenn Zelle leer ist
Part1.Update ' Part aktualisieren
End Sub