Hallo zusammen,
bei einem Makro soll eine Offsetebene und darauf eine neue Skizze erzeugt werden.
Mein Problem ist, dass bei der Erzeugung der Skizze folgende Zeilen auftauchen:
Dim reference2 As HybridShape
Set reference2 = hybridShapes1.Item("Ebene.1")
Das Programm bezieht sich also auf Ebene.1
Wenn es im Hauptkörper aber schon 5 Ebenen gibt, dann nennt das Makro die vorher neu erzeugte Ebene: Ebene.6
Der Bezug geht also verloren.
Meine Frage ist jetzt, was man dagegen tun kann.
Kann man ein frisch erzeugte Ebene fest bennen?
Ich habe einfach mal das Programm angehängt:
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 originElements1 As OriginElements
Set originElements1 = part1.OriginElements
Dim hybridShapePlaneExplicit1 As AnyObject
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Dim hybridShapePlaneOffset1 As HybridShapePlaneOffset
Set hybridShapePlaneOffset1 = hybridShapeFactory1.AddNewPlaneOffset(reference1, 20.000000, False)
Dim bodies1 As Bodies
Set bodies1 = part1.Bodies
Dim body1 As Body
Set body1 = bodies1.Item("Hauptkörper")
body1.InsertHybridShape hybridShapePlaneOffset1
part1.InWorkObject = hybridShapePlaneOffset1
part1.Update
Dim sketches1 As Sketches
Set sketches1 = body1.Sketches
Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = body1.HybridShapes
Dim reference2 As HybridShape
Set reference2 = hybridShapes1.Item("Ebene.1")
Dim sketch1 As Sketch
Set sketch1 = sketches1.Add(reference2)
Dim arrayOfVariantOfDouble1(8)
arrayOfVariantOfDouble1(0) = 0.000000
arrayOfVariantOfDouble1(1) = 0.000000
arrayOfVariantOfDouble1(2) = 20.000000
arrayOfVariantOfDouble1(3) = 1.000000
arrayOfVariantOfDouble1(4) = 0.000000
arrayOfVariantOfDouble1(5) = 0.000000
arrayOfVariantOfDouble1(6) = 0.000000
arrayOfVariantOfDouble1(7) = 1.000000
arrayOfVariantOfDouble1(8) = 0.000000
sketch1.SetAbsoluteAxisData arrayOfVariantOfDouble1
part1.InWorkObject = sketch1
Dim factory2D1 As Factory2D
Set factory2D1 = sketch1.OpenEdition()
Dim geometricElements1 As GeometricElements
Set geometricElements1 = sketch1.GeometricElements
Dim axis2D1 As GeometricElement
Set axis2D1 = geometricElements1.Item("Absolute Achse")
Dim line2D1 As CATBaseDispatch
Set line2D1 = axis2D1.GetItem("H-Richtung")
line2D1.ReportName = 1
Dim line2D2 As CATBaseDispatch
Set line2D2 = axis2D1.GetItem("V-Richtung")
line2D2.ReportName = 2
sketch1.CloseEdition
part1.InWorkObject = sketch1
End Sub
Vielen Dank schonmal im Voraus
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP