---

Hallo zusammen,

ich möchte in einer Skizze eine Projektion von einer Fläche (Außenkontur der Fläche) erzeugen. Dies habe ich auch soweit per Makro hinbekommen, über das Icon "Project 3D Elements". Nun möchte ich aber die Verlinkung der Projektion aufheben (isolieren) mit dem Icon "Create Datum", da sich die Projektion auf eine Tasche bezieht, die ich nach der Projektion wieder lösche.

Hier einmal das Makro:

Sub CATMain()
Dim partDocument1 As Document
Set partDocument1 = CATIA.ActiveDocument

Dim part1 As Part
Set part1 = partDocument1.Part

Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies

Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("#Skeleton")

Dim hybridBodies2 As HybridBodies
Set hybridBodies2 = hybridBody1.HybridBodies

Dim hybridBody2 As HybridBody
Set hybridBody2 = hybridBodies2.Item("#Sketches")

Dim UrsprungsElemente, Ebene                                        ' Referenzebene erzeugen
Set UrsprungsElemente = part1.OriginElements
Set Ebene = UrsprungsElemente.PlaneXY

part1.InWorkObject = hybridBody2

Dim sketches1 As Sketches
Set sketches1 = hybridBody2.HybridSketches

Dim skizze88 As Sketch
Set skizze88 = sketches1.Add(Ebene)
Dim Wzk88 As Factory2D                                        ' 2D-Werkzeugkasten erzeugen und Skizze öffnen
Set Wzk88 = skizze88.OpenEdition

Dim geometricElements1 As GeometricElements
Set geometricElements1 = skizze88.GeometricElements

Dim axis2D1 As GeometricElement
Set axis2D1 = geometricElements1.Item("AbsoluteAxis")

Dim line2D1 As CATBaseDispatch
Set line2D1 = axis2D1.GetItem("HDirection")

line2D1.ReportName = 1

Dim line2D2 As CATBaseDispatch
Set line2D2 = axis2D1.GetItem("VDirection")

line2D2.ReportName = 2

Dim bodies1 As Bodies
Set bodies1 = part1.Bodies

Dim body1 As Body
Set body1 = bodies1.Item("PartBody")

Dim shapes1 As Shapes
Set shapes1 = body1.Shapes

Dim add1 As Shape
Set add1 = shapes1.Item("PCB")

Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromBRepName("RSur Face Brp Pad.2;2);None );Cf11 ));WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MonoFond;MFBRepVersion_CXR15)", add1)

Dim geometricElements2 As GeometricElements
Set geometricElements2 = Wzk88.CreateProjections(reference1)

skizze88.CloseEdition

part1.UpdateObject skizze88

End Sub

Kann mir da jemand weiterhelfen?

Vielen Dank!

Gruß, Timo

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus
Vermutlich musst du die Projektin selektieren und über ein StartCommand löschen (Vorsicht: Sprachabhängig).
Siehe hier.

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Bernd,

irgendwie isoliert er die Skizze nicht, aber er gibt auch keine Fehlermeldung aus. Der Befehl bewirkt nichts oder mache ich etwas flasch?

Sub CATMain()
Dim partDocument1 As Document
Set partDocument1 = CATIA.ActiveDocument

Dim part1 As Part
Set part1 = partDocument1.Part

Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies

Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("#Skeleton")

Dim hybridBodies2 As HybridBodies
Set hybridBodies2 = hybridBody1.HybridBodies

Dim hybridBody2 As HybridBody
Set hybridBody2 = hybridBodies2.Item("#Sketches")

Dim UrsprungsElemente, Ebene                                        ' Referenzebene erzeugen
Set UrsprungsElemente = part1.OriginElements
Set Ebene = UrsprungsElemente.PlaneXY

part1.InWorkObject = hybridBody2

Dim sketches1 As Sketches
Set sketches1 = hybridBody2.HybridSketches

Dim skizze88 As Sketch
Set skizze88 = sketches1.Add(Ebene)
Dim Wzk88 As Factory2D                                        ' 2D-Werkzeugkasten erzeugen und Skizze öffnen
Set Wzk88 = skizze88.OpenEdition

Dim geometricElements1 As GeometricElements
Set geometricElements1 = skizze88.GeometricElements

Dim axis2D1 As GeometricElement
Set axis2D1 = geometricElements1.Item("AbsoluteAxis")

Dim line2D1 As CATBaseDispatch
Set line2D1 = axis2D1.GetItem("HDirection")

line2D1.ReportName = 1

Dim line2D2 As CATBaseDispatch
Set line2D2 = axis2D1.GetItem("VDirection")

line2D2.ReportName = 2

Dim bodies1 As Bodies
Set bodies1 = part1.Bodies

Dim body1 As Body
Set body1 = bodies1.Item("PartBody")

Dim body2 As Body
Set body2 = bodies1.Item("PCB")

Dim shapes1 As Shapes
Set shapes1 = body1.Shapes

Dim shapes2 As Shapes
Set shapes2 = body2.Shapes

Dim pocket1 As Shape
Set pocket1 = shapes2.Item("Pocket.2")

Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromBRepName("RSur Face Brp Pad.2;2);None );Cf11 ));WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MonoFond;MFBRepVersion_CXR15)", pocket1)

Dim geometricElements2 As GeometricElements
Set geometricElements2 = Wzk88.CreateProjections(reference1)

skizze88.CloseEdition

part1.UpdateObject skizze88

'Set selection2 = partDocument1.Selection
'selection2.Search "'Part Design'.Sketch;all"

Dim selection10 As Selection
Set selection10 = partDocument1.Selection
selection10.Clear
selection10.Add skizze88
CATIA.StartCommand ("isolate")

End Sub

Vielen Dank!

Gruß, Timo

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Bei einem Boundary im GSD Bereich funktioniert das isolieren mit "hybridShapeFactory5.DeleteObjectForDatum reference20", aber irgendwie funktioniert das nicht bei der Skizze.

            Dim hybridShapeFactory5 As Factory
            Set hybridShapeFactory5 = part1.HybridShapeFactory
            Dim reference19 As Reference
            Set reference19 = part1.CreateReferenceFromBRepName("RSur Face Brp Pad.2;1);None );Cf11 ));WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", body3)

            Dim hybridShapeBoundary2 As HybridShapeBoundary
            Set hybridShapeBoundary2 = hybridShapeFactory5.AddNewBoundaryOfSurface(reference19)

            hybridBody2.AppendHybridShape hybridShapeBoundary2

            part1.InWorkObject = hybridShapeBoundary2
            part1.UpdateObject hybridShapeBoundary2
            Dim reference20 As Reference
            Set reference20 = part1.CreateReferenceFromObject(hybridShapeBoundary2)

            Dim hybridShapeCurveExplicit2 As HybridShapeCurveExplicit
            Set hybridShapeCurveExplicit2 = hybridShapeFactory5.AddNewCurveDatum(reference20)

            hybridBody2.AppendHybridShape hybridShapeCurveExplicit2

            part1.InWorkObject = hybridShapeCurveExplicit2

            part1.UpdateObject hybridShapeCurveExplicit2

            hybridShapeFactory5.DeleteObjectForDatum reference20

            part1.UpdateObject hybridShapeFactory5

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

So, habe es jetzt hinbekommen.

Sub CATMain()
Dim partDocument1 As Document
Set partDocument1 = CATIA.ActiveDocument

Dim part1 As Part
Set part1 = partDocument1.Part

Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies

Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("#Skeleton")

Dim hybridBodies2 As HybridBodies
Set hybridBodies2 = hybridBody1.HybridBodies

Dim hybridBody2 As HybridBody
Set hybridBody2 = hybridBodies2.Item("#Sketches")

Dim UrsprungsElemente, Ebene                                        ' Referenzebene erzeugen
Set UrsprungsElemente = part1.OriginElements
Set Ebene = UrsprungsElemente.PlaneXY

part1.InWorkObject = hybridBody2

Dim sketches1 As Sketches
Set sketches1 = hybridBody2.HybridSketches

Dim skizze88 As Sketch
Set skizze88 = sketches1.Add(Ebene)
Dim Wzk88 As Factory2D                                        ' 2D-Werkzeugkasten erzeugen und Skizze öffnen
Set Wzk88 = skizze88.OpenEdition
'Catia.StartCommand "Create datum"
Dim geometricElements1 As GeometricElements
Set geometricElements1 = skizze88.GeometricElements

Dim axis2D1 As GeometricElement
Set axis2D1 = geometricElements1.Item("AbsoluteAxis")

Dim line2D1 As CATBaseDispatch
Set line2D1 = axis2D1.GetItem("HDirection")

line2D1.ReportName = 1

Dim line2D2 As CATBaseDispatch
Set line2D2 = axis2D1.GetItem("VDirection")

line2D2.ReportName = 2

Dim bodies1 As Bodies
Set bodies1 = part1.Bodies

Dim body1 As Body
Set body1 = bodies1.Item("PartBody")

Dim body2 As Body
Set body2 = bodies1.Item("PCB")

Dim shapes1 As Shapes
Set shapes1 = body1.Shapes

Dim shapes2 As Shapes
Set shapes2 = body2.Shapes

Dim pocket1 As Shape
Set pocket1 = shapes2.Item("Pocket.1")

Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromBRepName("RSur Face Brp Pad.2;2);None );Cf11 ));WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MonoFond;MFBRepVersion_CXR15)", pocket1)

Dim geometricElements2 As GeometricElements
Set geometricElements2 = Wzk88.CreateProjections(reference1)

skizze88.CloseEdition

part1.UpdateObject skizze88

skizze88.Name = "Projection"

Set selection2 = CATIA.ActiveDocument.Selection
selection2.Search "Name=Projection*;all"

CATIA.StartCommand ("Isolate")

End Sub

Vielen Dank nochmal!

Gruß Timo

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

ich habe jetzt das Problem, wenn eine Fläche eines Pads projiziert werden soll und sich eine Bohrung in dem Pad befindet kommt eine Fehlermeldung. Ich habe die Vermutung, dass es daran liegt weil es dann zwei geschlossene linienzüge sind?

Makro siehe vorherige Nachricht.

Habt ihr eine Erklärung dafür oder eine Lösung, um es zu beheben.

Vielen Dank!

Gruß Timo

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus
Kannst du ein Bild dazu posten?
Kommt solche eine Meldung auch wenn du das ganze Manuell machst?
Wie würdest du das manuell lösen?

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Projektion.jpg

Nein, deshalb wundert mich das auch so. In dem Bild sieht man das Pad mit der Bohrung. Manuell öffne ich eine neue Skizze, anschließend auf "Create Datum" und dann auf "Project 3D Element". Danach habe ich dann eine isolierte Skizze (Alle Linien sind weiß). Manuell klappt alles super, nur mit dem Makro bekomme ich eine Fehermeldung, sobald sich die Bohrung komplett in der Kontur befindet (vgl. Bild). Nehme ich die Bohrung raus funktioniert das Makro einwandfrei.

Ich kann mir das nicht erflären!

Gruß Timo

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus
Wie lautet die Fehlermeldung?

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Fehlermeldung.jpg

Guten Morgen Bernd,

im Anhang befindet sich die Fehlermeldung.

Vielen Dank!

Gruß Timo

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Fehlermeldung.jpg

Guten Morgen Bernd,
im Anhang befindet sich die Fehlermeldung.

Vielen Dank!

Gruß Timo

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP