Pick-Methode in idw für ein Bauteil (Autodesk/Inventor VBA)

Hallo Mario,

meines Wissens gibt es so einen Filter nicht. Meine Überlegung ist es über die in der .idw ausgewählte Kante eine Referenz zum Modell (.ipt) herzustellen, dann alle Modellkanten (in der .idw) einzublenden und dass alles in den OnPreSelect-Ereigniss zu packen, sodass nich nur eine, sondern alle Modellkanten beim OnPreSelect bzw. Drüberfahren mit dem Mauszeiger eingeblendet werden.
Es ist zwar nicht ganz so elegant, funktioniert aber in den meisten Fällen ganz gut.

Hier ist die Umsetzung:

Eine Klasse namens "clsModellAusIDW" erstellen und folgendes einfügen:

Code:

Option Explicit
Private WithEvents eI As Inventor.InteractionEvents
Private WithEvents eS As Inventor.SelectEvents
Private AuswahlAktiv As Boolean
Private occ As Inventor.ComponentOccurrence
Private Sub eS_OnPreSelect(ByRef PreSelectEntity As Object, _
   ByRef DoHighlight As Boolean, _
   ByRef MorePreSelectEntities As Inventor.ObjectCollection, _
   ByVal SelectionDevice As Inventor.SelectionDeviceEnum, _
   ByVal ModelPosition As Inventor.Point, _
   ByVal ViewPosition As Inventor.Point2d, _
   ByVal View As Inventor.View)
DoHighlight = False

Set MorePreSelectEntities = ThisApplication.TransientObjects.CreateObjectCollection

'' Referenz zur Kante.
Dim zKante As Inventor.DrawingCurve
Set zKante = PreSelectEntity.Parent

'' auf zugehörige Modellkante bzw. Modelfläche zugreifen.
Dim mGeom As Object ' As Inventor.EdgeProxy ODER Inventor.FaceProxy
Set mGeom = zKante.ModelGeometry

'' trotz des kDrawingCurveSegmentFilter - Filters können auch Linien von Skizzen
'' (die Ansichtbezogen erstellt wurden wie z.B.: Schnittverlauf)
'' selektiert werden, deswegen folgende If-Then-Else-Bediengung.
If mGeom.Type = Inventor.ObjectTypeEnum.kFaceProxyObject _
Or mGeom.Type = Inventor.ObjectTypeEnum.kEdgeProxyObject Then
'' Bezug auf referenziertes Modell festlegen.
Set occ = mGeom.ContainingOccurrence
Else: Exit Sub
End If

'' Referenz zur Ansicht.
Dim aktAnsicht As Inventor.DrawingView
Set aktAnsicht = zKante.Parent

'' Alle Modellkanten abrufen.
Dim zKantEnum As Inventor.DrawingCurvesEnumerator
Set zKantEnum = aktAnsicht.DrawingCurves(occ)

'' Alle Modellkanten "PreSelectieren" bzw. hervorheben.
Dim Kante As Inventor.DrawingCurve
For Each Kante In zKantEnum
Call MorePreSelectEntities.Add(Kante.Segments(1))
Next
DoHighlight = True
End Sub
Public Function SucheTeil() As ComponentOccurrence
'' neues InteractionEvents-Object erzeugen.
Set eI = ThisApplication.CommandManager.CreateInteractionEvents
'' Interaction aktivieren.
eI.InteractionDisabled = False

'eI.SelectionActive = True

'' Referenz zum SelectEvent.
Set eS = eI.SelectEvents

'' Filter setzen
eS.AddSelectionFilter (Inventor.SelectionFilterEnum.kDrawingCurveSegmentFilter)

ToolTipAnzeigen

'' InteractionEvents starten.
eI.Start
'' Schleife erzeugen: bis Auswahlvorgang beendet ist.
Do While AuswahlAktiv
ThisApplication.UserInterfaceManager.DoEvents
Loop
'' Bauteil zurückgeben.
If eS.SelectedEntities.Count > 0 Then
Set SucheTeil = occ
Else: Set SucheTeil = Nothing
End If
End Function
Private Sub Class_Initialize()
   AuswahlAktiv = True
End Sub

Private Sub Class_Terminate()
'' Aufräumen
eI.Stop
Set eS = Nothing
Set eI = Nothing
End Sub
Private Sub ToolTipAnzeigen()
ThisApplication.GeneralOptions.ShowCommandPromptTooltips = True
eI.StatusBarText = "Bauteil wählen."
End Sub
Private Sub eS_OnSelect(ByVal JustSelectedEntities As ObjectsEnumerator, _
ByVal SelectionDevice As SelectionDeviceEnum, _
ByVal ModelPosition As Point, _
ByVal ViewPosition As Point2d, _
ByVal View As View)
'' Schleife beenden.
AuswahlAktiv = False
End Sub
'' ESC-Taste wird gedruckt:
Private Sub eI_OnTerminate()
'' Schleife beenden.
AuswahlAktiv = False
End Sub

Das gehört in ein Modul (hiermit wird die Funktion aufgerufen):

Code:

Option Explicit
Public Sub ModellAusIDW()
'' Referenzu zur Zeichnung.
Dim zDok As DrawingDocument
Set zDok = ThisApplication.ActiveDocument
'' Alternative zur Pick-Methode.
Dim ModellAusIDW As New clsModellAusIDW
Dim Bauteil As ComponentOccurrence
Set Bauteil = ModellAusIDW.SucheTeil

'' .ipt öffnen.
Dim tDok As PartDocument
Set tDok = ThisApplication.Documents.Open(Bauteil.Definition.Document.FullDocumentName, True)
'' Zeichnung wieder aktiviern.
zDok.Activate

'' Ansicht platzieren.
ThisApplication.CommandManager.ControlDefinitions.Item("DrawingBaseViewCmd").Execute
'' Warten, bis Ansicht platziert wird, dann .ipt schließen
Dim AnsichtIstPlatziert As Boolean
AnsichtIstPlatziert = False
Do Until AnsichtIstPlatziert
ThisApplication.UserInterfaceManager.DoEvents
If Not ThisApplication.CommandManager.ActiveCommand = "DrawingBaseViewCmd" Then
AnsichtIstPlatziert = True
Else
tDok.Close (True)
End If
Loop
End Sub

Einfach eine Baugruppenzeichnung öffnen und Sub ausführen.

Letzter Codeabschnitt (Schleife nach Platzierung der Ansicht) funktioniert zwar, aber wahrscheinlich gibt es dafür eine bessere Lösung.

------------------
alexander

[Diese Nachricht wurde von metalgod am 18. Feb. 2016 editiert.]

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