VBA (Inventor 2018) - Feature bzw. die entstehenden Oberflächen färben

[fullevent]

Hallo zusammen,

ich beschäftige mich zur Zeit wieder etwas mit dem Thema "zeichnungslose Fertigung" und möchte an diesen Beitrag anknüpfen.

Das Makro färbt mir Extrusionen und Bohrungen ein. Dabei wird dem Feature eine Farbe zugewiesen.

z.B. 

tmpHole.Appearance = oDoc.AppearanceAssets.Item("Rot")

Das Bohrungen die allerdings gemustert oder gespiegelt sind, werden nicht als Bohrung erkannt.

Hier kann ich zwar der kompletten Anordnung die Farbe des Eltern-Elements geben

z.B. für rechteckige Anordnungen

For Each tmpRPattern In oFeatures.RectangularPatternFeatures
        tmpRPattern.Appearance = tmpRPattern.Definition.ParentFeatures.Item(1).Appearance
Next

Das funktioniert allerdings nur solange, wie die Anordnung nur ein Element mustert oder alle Elemente die gleiche Farbe besitzen.

Bei der Anordnung wie im Bild funktioniert das schon nicht mehr, weil ich keine Möglichkeit finde die einzelnen Bohrungen anzusprechen 

Das Ziel wäre es die Bohrungen entsprechend der Parent-Elemente eingefärbt werden. Also alle Bohrungen links in gelb, die mittlere Spalte in lila und die Bohrungen rechts in magenta.

Der Versuch die Bohrungen erst zu färben und dann zu mustern funktioniert nicht. Aber selbst wenn würde mir das nur bedingt weiter helfen..

Im Grunde wäre es egal ob das Feature oder die entsprechenden Oberflächen eingefärbt werden (was wären hier eigentlich die Unterschiede?)

Hat jemand eine Idee und kann mir einen Tipp geben?

Anbei noch meine ipt mit der ich teste.

Grüße und nachträglich noch ein frohes neues Jahr an alle!

Aleks

[michele.mk]

Hallo @fullevent,

um Hilfe zu bekommen, kannst du deine Frage hier posten:

Inventor Customization (Englisches Forum)

Ich hoffe das hilft dir weiter.

Gruß,

Michèle. 

[fullevent]

Hallo @michele.mk,

ich hab den Beitrag mal ins englische Forum gepostet.

Danke für den Tipp    Mal sehen ob sich hier was ergibt.

https://forums.autodesk.com/t5/inventor-customization/vba-inventor-2018-coloring-a-feature-or-the-re...

Grüße,
Aleks

[Juergen_Wagner · Accepted solution]

Wenn du Je Bohrung eine Reihe machst (anstellen von einer Reihe mit 3 verschiedenen Bohrungen) dann ist es einfach.

Hier als Beispiel die "Untersuchung" des Reihenelements:

Über das ParentFeatures ermittelst du (wenn es eben nur 1 Bohrung ist) die Apparance.

Diese ermittelte Farbe überträgst du dann alle Faces des Reihenfeatures.

Aber: Das klappt wie gesagt nur, wenn du je Bohrung eine Reihe machst.

Wenn du es mit der Reihe machen willst, die du gemacht hast dann musst du die 3 ParentFeature durchlaufen, ermittelst den Radius des der Fläche, die zylindrisch ist ...

... und dann gehst du durch die Flächen der durch die Reihe entstandenen Flächen und überall wo der Radius gleich ist machst du die Farbe gleich.

Allgemein:

1. Das ist nur eine ersten Idee, wie ich es mal probieren würde, nachdem ich mir das Reiheobjekt angeschaut habe.
2. Um überhaupt mal zu schauen, was in dem Reihenobjekt alles an Infos stecken, nutzt du mein VBA-Info Tool. Die reihe im Modellbrowser markieren und Makro ausführen und dann kannst du im Locals-Fenster sehen, was alles im den Reihenelement steckt.

[fullevent]

Abend @Juergen_Wagner,

Danke für den Tipp! Das werde ich mir gleich morgen mal genauer anschauen.

Man müsste vorher nur prüfen ob auch alle ParentFeatures unterschiedliche Radien haben.

Ich muss gestehen, ich nutze dein Info-Tool immer wenn ich versuche was zu programmieren. Oft weiß ich aber einfach nicht wo ich nach gewissen Merkmalen suchen soll.

Grüße

EDIT:

jetzt sehe ich erst, dass ich im aller ersten Post den falschen Beitrag verlinkt habe 

An diesen Beitrag wollte ich anknüpfen..
https://forums.autodesk.com/t5/inventor-deutsch/bearbeitungstyp-nach-bestimmten-kriterien-einfarben/...

[Juergen_Wagner]

---

@fullevent  schrieb:

Ich muss gestehen, ich nutze dein Info-Tool immer wenn ich versuche was zu programmieren. Oft weiß ich aber einfach nicht wo ich nach gewissen Merkmalen suchen soll.

---

Mir geht es da bei Objekten  die ich nicht gut kenne, genau gleich. 🙂 Ist mühsam aber wenigstens besteht die Möglichkeit, sich einen Überblick zu verschaffen. 

[fullevent · Accepted solution]

Da hast du natürlich recht. Manchmal sehr sehr mühselig, aber immer hin etwas 

Das hat mir jetzt auch keine Ruhe mehr gelassen..

@Juergen_Wagner dein Tipp hat mir super geholfen. Ein zwei Punkte habe ich für meine Zwecke ergänzt. Bestimmt habe ich ein paar Dinge nicht beachtet, aber das Makro macht soweit exakt das was es soll.

Morgen versuche ich das ganze in das "richtige" Makro einzubinden. Hier der Code mit dem ich getestet habe und anbei die ipt (Inventor 2016).

Public Sub test()
    Dim oDoc As PartDocument
    Set oDoc = ThisApplication.ActiveDocument
    
    Dim oObjCol As ObjectCollection
    Set oObjCol = oDoc.ComponentDefinition.Features.RectangularPatternFeatures.Item(1).ParentFeatures
    
    Dim oFace As Face
    Dim oFaces As Faces
    Set oFaces = oDoc.ComponentDefinition.Features.RectangularPatternFeatures.Item(1).Faces
    
    Dim iAnzahl As Integer
    iAnzahl = oObjCol.Count
    ReDim dRad(1 To iAnzahl) As Double
    ReDim sFarben(1 To iAnzahl) As String
    
    'Um alle Radien zu erfassen
    On Error Resume Next
    For i = 1 To iAnzahl
        If oObjCol.Item(i).Faces.Item(1).SurfaceType = kCylinderSurface Then
            If oObjCol.Item(i).Type = kHoleFeatureObject Then       'Um runde Extrusionen auszuschließen
                dRad(i) = oObjCol.Item(i).Faces.Item(1).Geometry.Radius
                sFarben(i) = oObjCol.Item(i).Faces.Item(1).Appearance.DisplayName
            End If
        End If
    Next
    
    'Um Bohrungen mit identischen Radien aber unterschiedlicher Farbe zu filtern
    For i = 1 To iAnzahl
        For j = i + 1 To iAnzahl
            If dRad(i) = dRad(j) And Not dRad(i) = 0 And Not sFarben(i) = sFarben(j) Then
                MsgBox "Es wurden gleiche Radien mit unterschiedlichen Farben gefunden!", vbOKOnly, "Makro wird abgebrochen.."
                Exit Sub
            End If
        Next
    Next
    
    'Identische Bohrungen einfärben
    Dim oTrans As Transaction
    Set oTrans = ThisApplication.TransactionManager.StartTransaction(oDoc, "Färben")
    For Each oFace In oFaces
        If oFace.SurfaceType = kCylinderSurface Then
            For i = 1 To iAnzahl
                If oFace.Geometry.Radius = dRad(i) Then
                    oFace.Appearance = oDoc.AppearanceAssets.Item(sFarben(i))
                End If
            Next
        End If
    Next
    oTrans.End
End Sub

Grüße und gute Nacht ^^

[Juergen_Wagner]

@fullevent Mir geht gerade das Herz auf wenn ich das Ergebnis sehe. Exakt so stelle ich mir das ganze vor. Kleine Hinweis als Minianschub und dann eine fertige Lösung und das in einer Nachtschicht. Top! 

[fullevent]

Vielen Dank für das tolle Kompliment!!

[Tarek_K]

Ich muss hier persönlich auch noch einmal ein Dankeschön an euch alle für das super Miteinander dalassen! 🙂 Wenn immer ich sowas sehe, wie Menschen freundlich miteinander (trotz der Online-Distanz) miteinander umgehen, um zusammen Dinge zu erreichen geht mir auch immer das Herz auf. 🙂 Danke!