Vorgegeben sind unzählich Punkte auf einer Fläche mit einer Geraden.
Nun habe ich ein Makro, das zwei punkte miteinander verbindet und im Anschluss die erzeugte Linie über die Flächensenkrechtelinie spiegelt.
Das Macro funktioniert jedoch eine Schleife einzubauen ist ???????
Könnte mir jemand helfen eine Schleife für das Makro zu erstellen.
Damit alle auf der Fläche bestehenden Punkte so verarbeitet werden.
Language="VBSCRIPT"
Sub CATMain()
Dim partDocument1 As Document
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridShapeFactory1 As Factory
Set hybridShapeFactory1 = part1.HybridShapeFactory
Dim parameters1 As Parameters
Set parameters1 = part1.Parameters
Dim hybridShapePointExplicit1 As Parameter
Set hybridShapePointExplicit1 = parameters1.Item("95SR")
Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(hybridShapePointExplicit1)
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("point on Face")
Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes
Dim hybridShapePointOnSurface1 As HybridShape
Set hybridShapePointOnSurface1 = hybridShapes1.Item("Punkt.11")
Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(hybridShapePointOnSurface1)
Dim hybridShapeLinePtPt1 As HybridShapeLinePtPt
Set hybridShapeLinePtPt1 = hybridShapeFactory1.AddNewLinePtPt(reference1, reference2)
Dim hybridBody2 As HybridBody
Set hybridBody2 = hybridBodies1.Item("Linien")
hybridBody2.AppendHybridShape hybridShapeLinePtPt1
part1.InWorkObject = hybridShapeLinePtPt1
part1.Update
Dim reference3 As Reference
Set reference3 = part1.CreateReferenceFromObject(hybridShapeLinePtPt1)
Dim hybridBody3 As HybridBody
Set hybridBody3 = hybridBodies1.Item("Flaeche")
Dim hybridShapes2 As HybridShapes
Set hybridShapes2 = hybridBody3.HybridShapes
Dim hybridShapeLineNormal1 As HybridShape
Set hybridShapeLineNormal1 = hybridShapes2.Item("Linie.21")
Dim reference4 As Reference
Set reference4 = part1.CreateReferenceFromObject(hybridShapeLineNormal1)
Dim hybridShapeSymmetry1 As HybridShapeSymmetry
Set hybridShapeSymmetry1 = hybridShapeFactory1.AddNewSymmetry(reference3, reference4)
hybridShapeSymmetry1.VolumeResult = False
hybridBody2.AppendHybridShape hybridShapeSymmetry1
part1.InWorkObject = hybridShapeSymmetry1
part1.Update
End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP