---

Hallo Leute,
ich bin hier grad ziemlich am verzweifeln: ich hab ca. 100 Punkte welche projeziert, verbunden und um desen Betrag verlängert werden müssen. Wenn ich das Makro aufnehme ist ja nur der jeweils ausgewählte Punkt im Makro enthalten.
Wie kann ich ins Makro einfügen, dass er diese Prozedur für alle Punkte durchführen soll?

Danke für eure Hilfe!

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

---

Hi und Willkommen,

sind bissl wenig info's.

-was sind das für Punkte (welcher Typ)
-was meinst du mit verbinden und verlängern
-bitte mal deinen Code posten und evtl. ein Bild der Baumstruktur

mfG
Mario

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

---

Makro.JPG

Es handelt sich hier um eingelesene Messpunkte über eine Excel-Tabelle. Diese sollen jetzt an einer gekrümmten Referenzebene "gespiegelt" werden.

D.h.: (für einen Punkt gesehen)

1. den Punkte auf die Fläche projezieren
2. diese beiden Punkte(eingelesen und projeziert) dann mit einer Geraden verbinden (Normale erstellen)
3. diese Gerade(Normale) um den Betrag der Geraden auf die andere Seite der Ebene bringen und dort einen Punkt erzeugen.

Im Anhang ist nochmal eine grobe Skizze: Rot ist die Ebene, Blau die Punkte und die grünen Pfeile stellen die Richtung da.

Hier noch der Makro-Code von der Aufzeichnung:

----------------------------------------------------------

Language="VBSCRIPT"
Sub CATMain()
Set partDocument1 = CATIA.ActiveDocument
Set part1 = partDocument1.Part
Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridBodies1 = part1.HybridBodies

Set hybridBody1 = hybridBodies1.Item("Eingelesene Punkte aus \\zw-emc-e\usr\hho\Eigene Dateien\P12F5000334\cvs_121119\2000C13_121119.csv")

Set hybridShapes1 = hybridBody1.HybridShapes
Set hybridShapePointCoord1 = hybridShapes1.Item("Point.929")
Set reference1 = part1.CreateReferenceFromObject(hybridShapePointCoord1)
Set hybridShapeOffset1 = hybridShapes1.Item("Offset.21")
Set reference2 = part1.CreateReferenceFromObject(hybridShapeOffset1)
Set hybridShapeProject1 = hybridShapeFactory1.AddNewProject(reference1, reference2)

hybridShapeProject1.SolutionType = 0
hybridShapeProject1.Normal = True
hybridShapeProject1.SmoothingType = 0
Set hybridBody2 = hybridBodies1.Item("Punkte_Spiegeln")
hybridBody2.AppendHybridShape hybridShapeProject1
part1.InWorkObject = hybridShapeProject1
part1.Update
Set reference3 = part1.CreateReferenceFromObject(hybridShapePointCoord1)
Set reference4 = part1.CreateReferenceFromObject(hybridShapeProject1)
Set hybridShapeLinePtPt1 = hybridShapeFactory1.AddNewLinePtPt(reference3, reference4)
hybridBody2.AppendHybridShape hybridShapeLinePtPt1
part1.InWorkObject = hybridShapeLinePtPt1
part1.Update

Set reference5 = part1.CreateReferenceFromObject(hybridShapeProject1)
Set reference6 = part1.CreateReferenceFromObject(hybridShapeLinePtPt1)
Set hybridShapeDirection1 = hybridShapeFactory1.AddNewDirection(reference6)
Set hybridShapeLinePtDir1 = hybridShapeFactory1.AddNewLinePtDir(reference5, hybridShapeDirection1, 0.000000, 0.319000, False)

hybridBody2.AppendHybridShape hybridShapeLinePtDir1
part1.InWorkObject = hybridShapeLinePtDir1
part1.Update
Set reference7 = part1.CreateReferenceFromObject(hybridShapeLinePtDir1)
Set hybridShapePointOnCurve1 = hybridShapeFactory1.AddNewPointOnCurveFromDistance(reference7, 0.319000, False)

hybridShapePointOnCurve1.DistanceType = 1
hybridBody2.AppendHybridShape hybridShapePointOnCurve1
part1.InWorkObject = hybridShapePointOnCurve1
part1.Update
End Sub

------------------------------------------

Ich hoffe Ihr versteht was ich meine?  

[Diese Nachricht wurde von haannsmaann am 05. Dez. 2012 editiert.]

[Diese Nachricht wurde von haannsmaann am 05. Dez. 2012 editiert.]

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

---

Hi, habe ich dich richtig verstanden? Du willst Punkte, die sich in einem GeometricalSet befinden über eine gekrümmte Fläche spiegeln? Wenn ja, finde ich dein Vorgehen im aufgenommen VBA-Code etwas umständlich. Du kannst auch gleich deinen Ausgangspunkt über den Projektionspunkt spiegeln. Anbei mal der VBAProject-Code (Achtung kein VB-Script). Du musst die Namen für das QuellGeometricalSet und die Spiegelfläche ändern. Am Besten währe eine UserSelection, InfoŽs dazu im Forum.

Code:

---

Option Explicit

Sub CATMain()
Dim MyPartDocument  As PartDocument
Dim MyPart          As Part
Dim MyHybShapeFact  As HybridShapeFactory
Dim MyHybBodies    As HybridBodies
Dim MyQuellHybBody  As HybridBody
Dim MyZielHybBody  As HybridBody
Dim MyHybShapes    As HybridShapes
Dim MyHybShape      As HybridShape
Dim MyHybProject    As HybridShapeProject
Dim MyHybSymmetry  As HybridShapeSymmetry
Dim MyHybFace      As HybridShape
Dim MyReference1    As Reference
Dim MyReference2    As Reference
Dim iPoints        As Integer

'Allgemeines
Set MyPartDocument = CATIA.ActiveDocument
Set MyPart = MyPartDocument.Part
Set MyHybShapeFact = MyPart.HybridShapeFactory
Set MyHybBodies = MyPart.HybridBodies

'Achtung: Name des QuellGeometricalSets anpassen oder eine Selection einbauen!!!!
Set MyQuellHybBody = MyHybBodies.Item("Quelle")

'ZielgeometricalSet anlegen
Set MyZielHybBody = MyHybBodies.Add
MyZielHybBody.Name = "Punkte_spiegeln"
MyPart.InWorkObject = MyZielHybBody

'Achtung: Name der Projektionsfläche anpassen oder eine Selection einbauen!!!!
Set MyHybShapes = MyQuellHybBody.HybridShapes
Set MyHybFace = MyHybShapes.Item("Offset.21")

'Schleife über alle Punkte im QuellgeometricalSet
For Each MyHybShape In MyHybShapes
        'Prüfen ob es sich um einen Punkt handelt
        If InStr(1, TypeName(MyHybShape), "Point") > 0 Then
           
            'Referencen löschen
            Set MyReference1 = Nothing
            Set MyReference2 = Nothing
           
            'Referencen setzen
            Set MyReference1 = MyPart.CreateReferenceFromObject(MyHybShape)
            Set MyReference2 = MyPart.CreateReferenceFromObject(MyHybFace)
           
            'Punktprojezieren
            Set MyHybProject = MyHybShapeFact.AddNewProject(MyReference1, MyReference2)
            MyHybProject.SolutionType = 0
            MyHybProject.Normal = True
            MyHybProject.SmoothingType = 0
            MyHybProject.Name = "Project_of_" & MyHybShape.Name
            MyZielHybBody.AppendHybridShape MyHybProject
            MyPart.UpdateObject MyHybProject
           
            'Referencen löschen
            Set MyReference1 = Nothing
            Set MyReference2 = Nothing
           
            'Referencen setzen
            Set MyReference1 = MyPart.CreateReferenceFromObject(MyHybShape)
            Set MyReference2 = MyPart.CreateReferenceFromObject(MyHybProject)
           

            'Punkt spiegeln
            Set MyHybSymmetry = MyHybShapeFact.AddNewSymmetry(MyReference1, MyReference2)
            MyHybSymmetry.VolumeResult = False
            MyHybSymmetry.Name = "Symmetrie_of_" & MyHybShape.Name
            MyZielHybBody.AppendHybridShape MyHybSymmetry
           
            'Punktezähler hoch zählen
            iPoints = iPoints + 1
        End If
Next

'Alles Updaten
MyPart.Update

'Fertigmeldung in Statusbar
CATIA.StatusBar = iPoints & " Punkte erfolgreich Bearbeitet)"

End Sub

---

mfG
Mario

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

---

Ja, hast du richtig verstanden. Auf die Idee, den Punkt gleich über dem Projektionspunkt zu spiegeln, bin ich garnicht erst gekommen. Vielen Dank! Werd ich morgen gleich ausprobieren!

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

---

So, habe nun folgenden Fehler: the method Item failed:

Set MyHybFace = MyHybShapes.Item("Offset.6")

In welchem Pfad muss die Fläche zu finden sein? Die Fläche Offset.6 ist auf jeden Fall vorhanden. Er findet sie aber anscheinend nicht.

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

---

Servus
Du musst die beiden Namen "MyQuellHybBody" (GeoSet auf der obersten Ebene) und "MyHybFace" (Name der Referenzfläche im GeoSet "MyQuellHybBody") im Code deinen Gegebenheiten anpassen.

Gruß
Bernd

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

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

---

Hi,

deinen Code zufolge müsste dein

GeometricalSet = "Eingelesene Punkte aus \\zw-emc-e\usr\hho\Eigene Dateien\P12F5000334\cvs_121119\2000C13_121119.csv"

und deine
Fläche="Offset.21"

heißen.

Ich habe angenommen das die Fläche im GeometricalSet der Punkte befindet (deswegen wäre ein Bild der Baumstruktur sinnvoll gewesen    ).

Wenn sich deine Ausgangsbedingungen ständig Ändern, ist wirklich eine Userselektion sinvoller, also den Benutzer das GeometricalSet der Punkte und die Spiegelfläche anwählen lassen.

mfG

Mario

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

---

Hi,

hab dir mal noch eine Selektion eingebaut.

Ggf. musst du den zweiten Selection-Filter etwas mehr eingrenzen.
Da InputObjectType(0) = "HybridShape" nicht nur Flächen zulässt.

Code:

---

Option Explicit

Sub CATMain()
Dim MyPartDocument  As PartDocument
Dim MyPart          As Part
Dim MyHybShapeFact  As HybridShapeFactory
Dim MyHybBodies    As HybridBodies
Dim MyQuellHybBody  As HybridBody
Dim MyZielHybBody  As HybridBody
Dim MyHybShapes    As HybridShapes
Dim MyHybShape      As HybridShape
Dim MyHybProject    As HybridShapeProject
Dim MyHybSymmetry  As HybridShapeSymmetry
Dim MyHybFace      As HybridShape
Dim MyReference1    As Reference
Dim MyReference2    As Reference
Dim iPoints        As Integer
Dim MySelection    'As Selection
Dim Status          As String
Dim InputObjectType(0)

'Allgemeines
Set MyPartDocument = CATIA.ActiveDocument
Set MyPart = MyPartDocument.Part
Set MyHybShapeFact = MyPart.HybridShapeFactory
Set MyHybBodies = MyPart.HybridBodies

'QuellgeometricalSet auswählen
Set MySelection = CATIA.ActiveDocument.Selection
InputObjectType(0) = "HybridBody"
Status = MySelection.SelectElement2(InputObjectType, "GeometricalSet mit Punkten selektieren! (ESC = Abbruch)", False)
        If (Status = "Cancel") Then
            MySelection.Clear
            End
        Else
            Set MyQuellHybBody = MySelection.Item2(1).Value
            Set MyHybShapes = MyQuellHybBody.HybridShapes
            MySelection.Clear
        End If

'Spiegelfläche auswählen
InputObjectType(0) = "HybridShape"
Status = MySelection.SelectElement2(InputObjectType, "Spiegelfläche selektieren! (ESC = Abbruch)", False)
        If (Status = "Cancel") Then
            MySelection.Clear
            End
        Else
            Set MyHybFace = MySelection.Item2(1).Value
            MySelection.Clear
        End If

'ZielgeometricalSet anlegen
Set MyZielHybBody = MyHybBodies.Add
MyZielHybBody.name = "Punkte_spiegeln"
MyPart.InWorkObject = MyZielHybBody

'Schleife über alle Punkte im QuellgeometricalSet
For Each MyHybShape In MyHybShapes
        'Prüfen ob es sich um einen Punkt handelt
        If InStr(1, TypeName(MyHybShape), "Point") > 0 Then
         
            'Referencen löschen
            Set MyReference1 = Nothing
            Set MyReference2 = Nothing
         
            'Referencen setzen
            Set MyReference1 = MyPart.CreateReferenceFromObject(MyHybShape)
            Set MyReference2 = MyPart.CreateReferenceFromObject(MyHybFace)
         
            'Punktprojezieren
            Set MyHybProject = MyHybShapeFact.AddNewProject(MyReference1, MyReference2)
            MyHybProject.SolutionType = 0
            MyHybProject.Normal = True
            MyHybProject.SmoothingType = 0
            MyHybProject.name = "Project_of_" & MyHybShape.name
            MyZielHybBody.AppendHybridShape MyHybProject
            MyPart.UpdateObject MyHybProject
         
            'Referencen löschen
            Set MyReference1 = Nothing
            Set MyReference2 = Nothing
         
            'Referencen setzen
            Set MyReference1 = MyPart.CreateReferenceFromObject(MyHybShape)
            Set MyReference2 = MyPart.CreateReferenceFromObject(MyHybProject)
         

            'Punkt spiegeln
            Set MyHybSymmetry = MyHybShapeFact.AddNewSymmetry(MyReference1, MyReference2)
            MyHybSymmetry.VolumeResult = False
            MyHybSymmetry.name = "Symmetrie_of_" & MyHybShape.name
            MyZielHybBody.AppendHybridShape MyHybSymmetry
         
            'Punktezähler hoch zählen
            iPoints = iPoints + 1
        End If
Next

'Alles Updaten
MyPart.Update

'Fertigmeldung in Statusbar
CATIA.StatusBar = iPoints & " Punkte erfolgreich Bearbeitet)"

End Sub

---

mfG
Mario

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

---

Hat super funktioniert, danke Mario - du hast mir echt eine menge arbeit erspart - Daumen hoch!

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