---

Hallo zusammen!

Möchte eine Ebene automatisiert erzeugen, welche parallel zur Anzeige liegt, also über eine Gleichung..

Die Aufzeichnung hat folgenden Code ergeben, aber ich weiß nicht, wie ich die einzelnen Parameter ermittle, sodass die Ebene parallel ist..

Jemand eine Idee? Wäre mMn ein sehr nützliches Feature mit einem Klick..

Code:

---

Sub CATMain()

Dim partDocument1 As PartDocument
Dim part1 As Part
Dim hybridShapeFactory1 As HybridShapeFactory
Dim hybridShapePlaneEquation1 As HybridShapePlaneEquation
Dim bodies1 As Bodies
Dim body1 As Body
Dim adoc As Document

On Error Resume Next
Set adoc = CATIA.ActiveDocument
If Err.Number <> 0 Then Exit Sub

Set selection1 = adoc.Selection
 
Select Case TypeName(adoc)

    Case "PartDocument"
   
        Set partDocument1 = adoc
   
    Case "ProductDocument"
   
        selection1.Search ("'Part Design'.Teil, in")
       
        If Not selection1.Count = 1 Then Exit Sub
       
        Set partDocument1 = adoc.Selection.Item(1).value.Parent.Product.ReferenceProduct.Parent
   
    Case Else
   
        MsgBox "Nicht unterstützter Dokumenttyp, breche ab.."
        Exit Sub

End Select

Set part1 = partDocument1.Part
Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridShapePlaneEquation1 = hybridShapeFactory1.AddNewPlaneEquation(0.823003, 0.367891, 0.432807, 20#)
Set bodies1 = part1.Bodies
Set body1 = bodies1.Item("Hauptkörper")

body1.InsertHybridShape hybridShapePlaneEquation1
part1.InWorkObject = hybridShapePlaneEquation1
part1.Update

End Sub

---

[Diese Nachricht wurde von geekv5 am 11. Jun. 2012 editiert.]

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

---

Servus
Versuch mal über "GetSightDirection" (siehe Doku) die Richtung der aktuellen Ansicht auszulesen, und dann zum erstellen der Ebene zur Verwenden.

Gruß
Bernd

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

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

---

Hallo Bernd,

funktioniert wie immer einwandfrei, hier der lauffähige code:

Code:

---

Sub CATMain()

Dim partDocument1 As PartDocument
Dim part1 As Part
Dim hybridShapeFactory1 As HybridShapeFactory
Dim hybridShapePlaneEquation1 As HybridShapePlaneEquation
Dim bodies1 As Bodies
Dim body1 As Body
Dim viewers1 As viewers
Dim viewer1 As Viewer
Dim sight1(2)
Dim adoc As Document

On Error Resume Next
Set adoc = CATIA.ActiveDocument
If Err.Number <> 0 Then Exit Sub

Set selection1 = adoc.Selection
  
Select Case TypeName(adoc)

    Case "PartDocument"
   
        Set partDocument1 = adoc
   
    Case "ProductDocument"
   
        selection1.Search ("'Part Design'.Teil, in")
       
        If Not selection1.Count = 1 Then Exit Sub
       
        Set partDocument1 = adoc.Selection.Item(1).value.Parent.Product.ReferenceProduct.Parent
   
    Case Else
   
        MsgBox "Nicht unterstützter Dokumenttyp, breche ab.."
        Exit Sub

End Select

Set part1 = partDocument1.Part
Set hybridShapeFactory1 = part1.HybridShapeFactory
Set viewers1 = CATIA.ActiveWindow.viewers
Set viewer1 = viewers1.Item(1)
Set viewpoint1 = viewer1.Viewpoint3D

viewpoint1.GetSightDirection sight1

Set hybridShapePlaneEquation1 = hybridShapeFactory1.AddNewPlaneEquation(sight1(0), sight1(1), sight1(2), 20#)
Set bodies1 = part1.Bodies
Set body1 = bodies1.Item("Hauptkörper")

body1.InsertHybridShape hybridShapePlaneEquation1

End Sub

---

Thx für die schnelle Hilfe und 10 Us für dich  

[Diese Nachricht wurde von geekv5 am 11. Jun. 2012 editiert.]

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

---

Hatte da auch einmal eine Funktion geschrieben und lässt sich sicher auch als Funktion besser in den eigenen Code integrieren:

Code:

---

' Erzeugt eine Ebene parallel zur Ansicht
Private Function createPlaneParallelToScreen(ByRef i_partWork As MECMOD.Part, ByRef i_hybBodyWork As MECMOD.HybridBody) As HybridShapeTypeLib.HybridShapePlaneEquation

    'Dim arrDblOrigin(2)        As Variant 'Double
    Dim arrDblSightDirection(2) As Variant 'Double
    Dim axisSystemsWork        As AxisSystems
    Dim axisSystemWork          As AxisSystem
    Dim hybShapeFactWork        As HybridShapeFactory
    Dim refWork                As Reference
   
    Set hybShapeFactWork = i_partWork.HybridShapeFactory
   
    'CATIA.ActiveWindow.ActiveViewer.viewPoint3D.GetOrigin arrDblOrigin 'Array des Ursprungs
    CATIA.ActiveWindow.ActiveViewer.viewPoint3D.GetSightDirection arrDblSightDirection 'Array des Ziels
    'CATIA.ActiveWindow.ActiveViewer.Viewpoint3D.GetUpDirection aUpDirection 'Array Richtung oben
   
    Call invertVector(arrDblSightDirection)
   
    Set createPlaneParallelToScreen = hybShapeFactWork.AddNewPlaneEquation(arrDblSightDirection(0), arrDblSightDirection(1), arrDblSightDirection(2), 0)

    Set axisSystemsWork = i_partWork.AxisSystems

    On Error Resume Next
        Set axisSystemWork = axisSystemsWork.Item("Absolute Axis System")
       
        If (Not Err.Number = 0) Then
       
            Set axisSystemWork = axisSystemsWork.Item(1)
       
        End If
    On Error GoTo 0

    If (Not axisSystemWork Is Nothing) Then
   
        Set refWork = Nothing
        Set refWork = i_partWork.CreateReferenceFromObject(axisSystemWork)
       
    End If
   
    createPlaneParallelToScreen.RefAxisSystem = refWork

    i_hybBodyWork.AppendHybridShape createPlaneParallelToScreen
    i_partWork.Update

End Function

---

Wie man sieht ist hier aber keien Dokumentenprüfung drin, diese muss dem Aufruf erfolgen und das Part wird dann einfach übergeben, sowie das GeometricalSet, wo die Ebene rein soll.

------------------
Mit freundlichen Grüßen,
Henry Schneider
alias Lila

Es gibt einen ewigen Wettkampf zwischen der Natur und den Ingenieuren:
Die Ingenieure versuchen, immer idioten-sicherere Systeme zu bauen,
die Natur versucht, immer bessere Idioten zu bauen

Xing

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