Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Inventor
  VBA Problem

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
  
PNY baut sein Angebot für den Vertrieb von NVIDIA Software-Angeboten für Reseller und professionelle Anwender aus
Autor Thema:  VBA Problem (515 mal gelesen)
mario2
Mitglied


Sehen Sie sich das Profil von mario2 an!   Senden Sie eine Private Message an mario2  Schreiben Sie einen Gästebucheintrag für mario2

Beiträge: 8
Registriert: 23.10.2002

erstellt am: 23. Okt. 2002 21:33    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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

mtl3d
Ehrenmitglied
Konstrukteur


Sehen Sie sich das Profil von mtl3d an!   Senden Sie eine Private Message an mtl3d  Schreiben Sie einen Gästebucheintrag für mtl3d

Beiträge: 1544
Registriert: 03.05.2002

Pro/E Wildfire, Mechanica, Acad, Inventor, 3DS-MAX, NT, W2K, XP, Linux

erstellt am: 23. Okt. 2002 21:58    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für mario2 10 Unities + Antwort hilfreich

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

Pisarz
Mitglied



Sehen Sie sich das Profil von Pisarz an!   Senden Sie eine Private Message an Pisarz  Schreiben Sie einen Gästebucheintrag für Pisarz

Beiträge: 280
Registriert: 05.03.2002

AIP2011 Win7x64
HP Z400/W3565(3.2GHz) 12GB RAM
100GB SSD / 1TB Raid1
MSI R5770 Hawk
SpacePilot

erstellt am: 24. Okt. 2002 13:30    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für mario2 10 Unities + Antwort hilfreich


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

mario2
Mitglied


Sehen Sie sich das Profil von mario2 an!   Senden Sie eine Private Message an mario2  Schreiben Sie einen Gästebucheintrag für mario2

Beiträge: 8
Registriert: 23.10.2002

erstellt am: 24. Okt. 2002 19:14    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2024 CAD.de | Impressum | Datenschutz