---

Ich möchte über die Eigenschaften von zwei Elementen (einem Zylinder und einer Ebene) feststellen ob diese senkrecht aufeinander stehen. Durch selektieren der Elemente bekomme ich die entsprechenden Flächen (ein Zylinder und eine Ebene). Wie kann ich nun über VBA auswerten, ob die Achse des Zylinders senkrecht auf der Ebene steht ??

Vielen Dank für jeden Hinweis

Mario2

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

---

Hallo,

1. Schnittpunkt Achse mit Ebene
2. einer der Achsenendpunkte (<> Ebene) darf, in die Ebene projiziert, keine Abweichung in X/Y zum Schnittpunkt haben.

ciao

Achim

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

MTL GmbH, Ingenieurbüro, Maschinenentwicklung für die Lebensmittelindustrie und Pharmazie

[Diese Nachricht wurde von mtl3d am 23. Oktober 2002 editiert.]

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

---

screen1.jpg screen2.jpg

Hi Mario2,
vielleicht hilft Dir das weiter:

Code:

---

Sub EbenenParallel()

Dim oSS As SelectSet
Dim oFace1 As FaceProxy
Dim oFace2 As FaceProxy
Dim oPlane1 As Plane
Dim oPlane2 As Plane

'Wenn zwei planare Flächen gewählt sind, dann extrahiere die PLANE Objekte, sonst Fehlermeldung

  Set oSS = ThisApplication.ActiveDocument.SelectSet
 
  If oSS.Count <> 2 Then
    MsgBox "Bitte zwei Flächen markieren."
    Exit Sub
  End If
  If (oSS(1).Type <> kFaceProxyObject) Or (oSS(2).Type <> kFaceProxyObject) Then
    MsgBox "Bitte zwei Flächen markieren (evtl. Auswahlmodus auf 'Fläche' setzen)."
    Exit Sub
  End If
   
  Set oFace1 = ThisApplication.ActiveDocument.SelectSet.Item(1)
  Set oFace2 = ThisApplication.ActiveDocument.SelectSet.Item(2)

  If (oFace1.SurfaceType <> kPlaneSurface) Or (oFace2.SurfaceType <> kPlaneSurface) Then
    MsgBox "Bitte zwei ebene Flächen markieren."
    Exit Sub
  End If

  Set oPlane1 = oFace1.Surface(kPlaneSurface)
  Set oPlane2 = oFace2.Surface(kPlaneSurface)
 
'Die PlaneObjekte sind parallel, wenn der Winkel Phi zwischen den Normalen 0° oder 180° ist, d.h. Cos Phi = 1 oder -1
'
' Cos Phi = ab/|a|*|b| - wobei |a| und |b| = 1 sind, da ja "Normale"

 
  Dim cphi As Double
 
  cphi = oPlane1.Normal.x * oPlane2.Normal.x + oPlane1.Normal.y * oPlane2.Normal.y + oPlane1.Normal.Z * oPlane2.Normal.Z
Debug.Print Str(cphi)

'Prüfe auf 1 oder -1 mit Toleranz
 
  If (1 - Abs(cphi)) < 0.00000001 Then
    MsgBox "Flächen sind parallel"
  Else
    MsgBox "Flächen sind nicht parallel"
  End If
     
End Sub

---

------------------
Grüße Jörgen

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

---

Hallo Jörgen,

vielen Dank für den Code Schnipsel. Ich habe Ihn noch für eine Zylinderfläche und eine Ebene geändert. Der Rest ist gleich.

Nochmals vielen Dank

Mario 2

Sub EbenenParallel()
  Dim oCylinder1 As Cylinder
  Dim oPlane2 As Plane
  Dim cphi As Double
 
'  prt1 - Objekt 1 mit Zylinderfläche
'  prt2 - Objekt 2 mit ebener Fläche

  Set oCylinder1 = prt1.Surface(kCylinderSurface)
  Set oPlane2 = prt2.Surface(kPlaneSurface)
 
'Die PlaneObjekte sind parallel, wenn der Winkel Phi zwischen den Normalen 0° oder 180° ist, d.h. Cos Phi = 1 oder -1
'
' Cos Phi = ab/|a|*|b| - wobei |a| und |b| = 1 sind, da ja "Normale"

 
  cphi = oCylinder1.AxisVector.X * oPlane2.Normal.X + oCylinder1.AxisVector.Y * oPlane2.Normal.Y + oCylinder1.AxisVector.Z * oPlane2.Normal.Z
Debug.Print Str(cphi)

'Prüfe auf 1 oder -1 mit Toleranz
 
  If (1 - Abs(cphi)) < 0.00000001 Then
    MsgBox "Flächen sind parallel"
  Else
    MsgBox "Flächen sind nicht parallel"
  End If

End Sub

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