Code:
Sub CATMain()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 = hybridBodies1.Item("Geometrisches Set.1")
Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes
Dim hybridShapeLinePtDir1 As Line
Set hybridShapeLinePtDir1 = hybridShapes1.Item("Linie.1")
Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(hybridShapeLinePtDir1)
Dim hybridShapeLineAngle1 As Line
Set hybridShapeLineAngle1 = hybridShapes1.Item("Linie.2")
Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(hybridShapeLineAngle1)
Dim hybridShapeIntersection1 As HybridShapeIntersection
Set hybridShapeIntersection1 = hybridShapeFactory1.AddNewIntersection(reference1, reference2)
hybridShapeIntersection1.PointType = 0
hybridShapeIntersection1.ExtendMode = 3
hybridBody1.AppendHybridShape hybridShapeIntersection1
part1.InWorkObject = hybridShapeIntersection1
'Fehlerbehandlung ausschalten
On Error Resume Next
part1.Update
'Fehlerabarbeiten
If Err.Number <> 0 Then
MsgBox "Die Linien schneiden sich nicht"
partDocument1.Selection.Add hybridShapeIntersection1
partDocument1.Selection.Delete
End If
'Fehlerbehandlung einschalten
On Error GoTo 0
End Sub
Foren auf CAD.de (alle Foren)
| 
