---

Hallo!

Schon wieder eine Frage an euch zum Thema API!

Ich möchte per Makro alle Verknüpfungen in einer Baugruppe durchsuchen, die Finden in der 2 gesuchte Teile stecken und dann die Flache auslesen mit der die beiden Teile deckungsgleich verknüpft sind.
Bis zum Flächen auslesen steht schon alles.
Hat von euch jemand eine Idee wie ich von einer ausgewählten Verknüpfung auf die Flächen der Bauteile komme und diese Auswählen kann?
Am besten wäre es wenn ich den genauen Namen der Fläche hätte, sodass ich diese später mit dem selectbyid auswählen kann! Geht dies überhaupt?

Danke und Gruß
Sebastian

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

---

Hi Bastl,

vom mate2-> mateEntity2-> Refernce, ReferenceType und ReferenceComponent sollten Dir helfen

------------------
Gruß Ingo

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

---

Hallo Ingo,

danke für deine Antwort.
Die genannten Befehle habe ich mirschon näher angesehen, aber aus irgend einem Grund komme ich auf keinen grünen Zweig.
Denke mir fehlt noch irgend ein Object im Syntax oder Ähnliches!

Soweit bin ich bisher:

Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swComp As SldWorks.Component2
    Dim Part As Object
    Dim c As String
    Dim d As String
    Dim TeilName As String
    Dim retval As Boolean
    Dim boolstatus As Boolean
    Dim SelMgr As Object
    Dim longstatus As Long, longwarnings As Long
    Dim Skizzenpunkt As Boolean
    Dim Normteil As Boolean
    Dim BGname As String
    Dim faces As Variant
    Dim swMate                      As SldWorks.Mate2
   
   
'------------------------------------------------------------------------------
    Set swApp = Application.SldWorks
    Set Part = swApp.ActiveDoc
   
    BGname = Part.GetTitle
    c = StrReverse(BGname) ' dreht string um um und löscht Dateibezeichnung
    d = Mid(c, InStr(c, ".") + 1)
    BGname = StrReverse(d)

    Set swSelMgr = Part.SelectionManager
   
       
    For i = 1 To swSelMgr.GetSelectedObjectCount
   
        If swSelMgr.GetSelectedObjectType(i) = swSelEXTSKETCHPOINTS _
                Or swSelMgr.GetSelectedObjectType(i) = swSelVERTICES _
                Or swSelMgr.GetSelectedObjectType(i) = swSelSKETCHPOINTS Then
       
            Skizzenpunkt = True
            k = i
            Set swpunktcomp = swSelMgr.GetSelectedObjectsComponent3(k, 0)
           
           
           
        Else
            j = i
            Set swcomp11 = swSelMgr.GetSelectedObjectsComponent3(j, 0)
           
            TeilName = "Punkt1@Positionierskizze@" + swcomp11.Name + "@" + BGname
            Normteil = True
           
           

    End If
 

    Next
    swSelMgr.DeSelect (j) 'delselektiert das Normteil, damit nicht 3 Auswahlen existieren
   
    If (Skizzenpunkt = False And Normteil = False) Then
    MsgBox "Bitte einen Positionierpunkt auf dem Bauteil und ein Normteil wählen!"
    End
    End If
    If i > 3 Then
    MsgBox "Zu viele Auswahlen, bitte nur einen Punkt und ein Normteil auswählen!"
    End
    End If

'
'
'  boolstatus = Part.Extension.SelectByID2(TeilName, "EXTSKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
'
'    Set Feature = Part.AddMate2(0, -1, False, 0.02464807137666, 0, 0, 1, 1, 0.5235987755983, 0.5235987755983, 0.5235987755983, longstatus)
    Part.ClearSelection2 True
    retval = Part.EditRebuild3()
   
   
   
'----------------------------------------------------------------

    Dim FeatureData As Object
   
    Dim featureName As String
    Dim subFeatureName As String

    Set swApp = CreateObject("SldWorks.Application")
    Set Part = swApp.ActiveDoc

 
    Set Feature = Part.FirstFeature
 
    While Not Feature Is Nothing
   
        featureName = Feature.Name ' Get the name of the feature
        typ = Feature.GetType
        If typ = 33 Then
        GoTo 10
        End If
        Set Feature = Feature.GetNextFeature()
    Wend

10
  Set subfeat = Feature.GetFirstSubFeature
    While Not subfeat Is Nothing
    subFeatureName = subfeat.Name
    Dim swMateEnt(2)                As SldWorks.MateEntity2
   
    boolstatus = Part.Extension.SelectByID2(subFeatureName, "MATEGROUPS", 0, 0, 0, True, 0, Nothing, 0)
    Part.ActivateSelectedFeature
    Set swMate = subfeat.GetSpecificFeature2
   
   
    For i = 0 To 1
        Set swMateEnt(i) = swMate.MateEntity(i)
        Set swComp = swMateEnt(i).ReferenceComponent
        'MsgBox swComp.Name2
        If swComp.Name2 = swcomp11.Name Then
            GoTo 11
        End If
    Next i
    Set subfeat = subfeat.GetNextSubFeature
  Wend
 
11
'????????????????????????????????????????????????????
'???????????????????????????????????????????????????? 
    End Sub

Vielleicht hast du ja ne Idee,

Gruß Sebastian

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

---

Hi Bastl,
Kurzer AUsschnitt aus einen Progamm von mir:

    'swApp.SendMsgToUser "neue Kompnente einfügt! " & name_new_component
    Set ModelDoc = swAssy
    Set swFeature = ModelDoc.FirstFeature()
    While ((Not swFeature Is Nothing) And (swFeature.GetTypeName() <> "MateGroup"))
        Set swFeature = swFeature.GetNextFeature
    Wend
    'swApp.SendMsgToUser swFeature.Name
    Set swSubFeature = swFeature.GetFirstSubFeature
    While (Not swSubFeature Is Nothing)
        Set swLastFeature = swSubFeature
        Set swSubFeature = swSubFeature.GetNextSubFeature
    Wend
    'swApp.SendMsgToUser swLastFeature.Name & swLastFeature.GetTypeName()
    'das letzte feature ist das neu hinzugfügte
  If (Not swLastFeature Is Nothing) Then
        If (swLastFeature.GetTypeName() = "MateCoincident") Then
            Set swMate = swLastFeature.GetSpecificFeature()
            swMateEntitiesVar = swMate.GetMateEntities()
            If (Not (IsEmpty(swMateEntitiesVar) Or IsNull(swMateEntitiesVar))) Then
                'swApp.SendMsgToUser Mid(swMateEntitiesVar(0).GetComponentName(), 2)
                ' das 2. entity ist das Betriebsmittel, Prüfen ob name gleich dem eingefügten BM
                If (Mid(swMateEntitiesVar(1).GetComponentName(), 2) = name_new_component) Then
                    'Schauen ob Skizze ohne Feature mit Namen "FP_M?" existiert
                    'bis BM gehen
                    name_tragblech = Mid(swMateEntitiesVar(0).GetComponentName(), 2)
                    'swApp.SendMsgToUser name_tragblech & swMateEntitiesVar(0).GetEntityType()
                    Set swConf = ModelDoc.GetActiveConfiguration
                    Set swRootComp = swConf.GetRootComponent
                    vChildComp = swRootComp.GetChildren
                    'über alle Komponenten gehen
                    For i = 0 To UBound(vChildComp)
                        Set swChildComp = vChildComp(i)
                        If (swChildComp.Name2 = name_new_component) Then
                            lv_sketch_found = False
                            Set swBMComp = swChildComp
                            Set swFeature = swChildComp.FirstFeature
                            While ((Not swFeature Is Nothing) And (lv_sketch_found = False))
                                If ((swFeature.GetTypeName = "ProfileFeature") And ((Left(swFeature.Name, 4) = "FP_M") Or (UCase(swFeature.Name) = "FP_NIETEN"))) Then
                                    lv_sketch_found = True
                                Else
                                    Set swFeature = swFeature.GetNextFeature
                                End If
                            Wend
                        Else
                            If ((swChildComp.Name2 = name_tragblech) And (swMateEntitiesVar(0).GetEntityType() = swMatePlane)) Then
                                'Speichern der Tragblech Komponente
                                Set swTragblech = swChildComp
                                lv_tragblech_found = True
                            End If
                        End If
                       
                    Next i

Für telefonischen Kontakt frage Bernd!

------------------
Gruß Ingo

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