---

Hallo zusammen,

ich habe ein Makro, mit dem ich die Flächen der Einzelteile (mit einem Klick auf das Makro) alle markieren und anschließend eine Farbe auswählen und zuweisen kann.

Code:

---

Sub AlleFlaechenWaehlen()
    If (ThisApplication.ActiveDocumentType <> kPartDocumentObject) Then
        MsgBox "Nur für Bauteile gedacht...", vbOKOnly, "Falscher Dokumenttyp"
        Exit Sub
    End If
       
    Dim oPart As PartDocument
    Dim oFace As Face
    Dim oSurfaceBody As SurfaceBody
   
    Set oPart = ThisApplication.ActiveDocument
    For Each oSurfaceBody In oPart.ComponentDefinition.SurfaceBodies
        For Each oFace In oSurfaceBody.Faces
            oPart.SelectSet.Select oFace
        Next
    Next
End Sub

---

Folgendes Problem:
nachdem ich jetzt meine Arbeit (noch ohne die Flächen farbig zu markieren, weil es ja erstmal ein Entwurf ist und anfangs sowieso noch nicht sicher ist wie es letztendlich genau aussehen wird) gemacht habe, sehe ich eine Schweißbaugruppe mit 20 Einzelteilen vor mir. Jetzt muss ich jedes Einzelteil separat öffnen, alle Flächen markieren und die Farbe zuweisen. Eine nervige Arbeit.

Wie muss ich den Code umschreiben, damit ich auch innerhalb der Baugruppe alle Flächen der Einzelteile farbig markieren kann? Inventor könnte die Einzelteile selbst öffnen, alle Flächen markieren, Farbe zuweisen und Einzelteil wieder schließen.
Aber wie muß der Code dazu aussehen?
Könnt ihr mir bitte weiterhelfen?

Vielen Dank

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

Du bist die Aufgabe - Franz Kafka

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

---

hier gabs schon mal ein Thema, das die relevanten Sachen enthalten sollte (Schleife in einer IAM über alle Komponenten, jede Komponente färben)
https://ww3.cad.de/foren/ubb/Forum50/HTML/037829.shtml
Hier auch eine Schleife über die Komponenten: https://ww3.cad.de/foren/ubb/Forum50/HTML/038828.shtml

Was ich nicht verstehe: Warum müssen die Flächen gefärbt werden und nicht die Komponenten?

------------------
Gruß KraBBy

[Diese Nachricht wurde von KraBBy am 27. Jun. 2019 editiert.]

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

---

hier mal ein noch recht gebastelter/provisorischer Code. Lief aber in meinem kleinen Test durch.

Die Logik ist noch sehr Dumm/einfach, z.B.
- Schleife geht durch alle Komponenten. Mehrfach verwendete Einzelteile werden entsprechend mehrmals durchgearbeitet
  das ist im Grunde Schwachsinn und sollte geändert werden (evtl. auf oDoc.ReferencedDocuments)
- Unterbaugruppen werden übergangen
- Farbe ist fest im Code enthalten

Der Name der Farb-Bibliothek muss im Code angepasst werden!

Das könnte Deiner Aufgabe entsprechen, wobei mir trotzdem nicht klar ist, wofür man das benötigen könnte (siehe voriger Post)

Code:

---

Private Sub IAM_ColorAllFaces_Main()
' Aus IAM heraus die Flächen aller Komponenten färben
'
' Schleife durch alle Komponenten einer Bgr
' es werden alle Flächen der Unterkomponenten gefärbt
' nur Bauteile! (Unter-Bgr. werden übersprungen, ggf. müsste das noch eingebaut werden)
'
' KraBBy 27.06.2019

    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveDocument
   
    Dim oOccs As ComponentOccurrences
    Set oOccs = oDoc.ComponentDefinition.Occurrences
   
    'hier wäre wohl eine Benutzereingabe sinnvoll, bei der die Farbe festgelegt wird
    ' Inputbox? ggf. mit Prüfung, ob die Farbe auch in der Bib. enthalten ist
    '  sonst kommt die Fehlermeldung für jede Komponente
    ' oder Farbe von ausgewählter Fläche nehmen? bzw. vom User wählen lassen?
    Dim sFarbe As String
    sFarbe = "Blau"    '(zunächst) hier fest ProgrammCode
   
    'evtl. mal das Update ausschalten um den Ablauf zu beschleunigen
    'ThisApplication.ScreenUpdating = False
   
    'Schleife durch die Komponenten der IAM
    Dim oOcc As ComponentOccurrence
    For Each oOcc In oOccs
        Call AlleFlaechenFaerbenIPT(oOcc, sFarbe)
    Next
   
    'Aktualisieren
    ThisApplication.ScreenUpdating = True  'falls oben ausgeschaltet
    oDoc.Update    'Dokument aktualisieren
    ThisApplication.ActiveView.Update  'Ansicht aktualisieren (zur Sicherheit)
   
    MsgBox "finished", , "Fertig"

End Sub

Private Sub AlleFlaechenFaerbenIPT(oOcc As ComponentOccurrence, sColor As String)
' weißt allen Flächen die angegebene Farbe zu
' ausgehend von Komponente, ABER eingefärbt werden die Flächen im Einzelteil!
'
    'nur für Bauteile
    If oOcc.DefinitionDocumentType <> kPartDocumentObject Then Exit Sub
       
    Dim oPart As PartDocument
    Set oPart = oOcc.Definition.Document
   
    'Sicherstellen, dass Farbe/Asset im Dokument enthalten ist
    Dim oCol As Asset
    Set oCol = makeAsset_available(oPart, sColor)
    If oCol Is Nothing Then Exit Sub    'Farbe/Asset konnte nicht gefunden werden
   
    Dim oFace As Face
    Dim oSurfaceBody As SurfaceBody
     
    For Each oSurfaceBody In oPart.ComponentDefinition.SurfaceBodies
        For Each oFace In oSurfaceBody.Faces
            oFace.Appearance = oCol
        Next
    Next
End Sub

Private Function makeAsset_available(oDoc As Document, sColorName As String) As Asset
' püft ob die angegebene Farbe/Asset im angegebenen Dokument enthalten ist
' falls nicht, wird sie aus der Bibliothek eingefügt
' (erst dann steht sie im Dokument zur Verfügung)
    '    oDoc      :  PartDocument oder AssemblyDocument
    '  sColorName  :  Name der Farbe
' Rückgabewert ist die entsprechende Farbe als Asset-Object
'

    Dim localAsset As Asset
    On Error Resume Next
    Set localAsset = oDoc.Assets.Item(sColorName)
    If Err Then
        ' Failed to get the appearance in the document, so import it.
       
        ' Get an asset library by name.  Either the displayed name (which
        ' can changed based on the current language) or the internal name
        ' (which is always the same) can be used.
        Dim assetLib As AssetLibrary
        Set assetLib = ThisApplication.AssetLibraries.Item("Bib_Name")  'Name der Bibliothek anpassen!
        'Set assetLib = ThisApplication.AssetLibraries.Item("314DE259-5443-4621-BFBD-1730C6CC9AE9")
       
        ' Get an asset in the library.  Again, either the displayed name or the internal
        ' name can be used.
        Dim libAsset As Asset
        Set libAsset = assetLib.AppearanceAssets.Item(sColorName)
       
        If libAsset Is Nothing Then  'Library oder Asset nicht vorhanden!
            ThisApplication.ScreenUpdating = True
            MsgBox "Keine Farbe mit diesem Namen in der Bibliothek gefunden!" & vbCrLf & _
                sColorName, vbInformation, "abgebrochen"
            Exit Function
        End If
       
        ' Copy the asset locally.
        Set localAsset = libAsset.CopyTo(oDoc)
    End If
    On Error GoTo 0
   
    'Rückgabewert
    Set makeAsset_available = localAsset
   
End Function

---

------------------
Gruß KraBBy

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