| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: Code zum Einfärben der Flächen von Einzelteilen in der Schweißbaugruppe (1232 / mal gelesen)
|
Honigbär Mitglied Angestellter
Beiträge: 158 Registriert: 22.10.2006 CATIA V5 R24 Solid Edge Version 17 Pro-E Wildfire 4.0 Autodesk Inventor Professional 2014 MathCAD 13 Intel Centrino 2 (Pentium III Xeon) 2,53 GHz 6GB RAM Win 7 Ultimate (64 Bit) ATI Mobility Radeon HD 4650 SSD von Samsung (Festplatte)
|
erstellt am: 26. Jun. 2019 16:41 <-- editieren / zitieren --> Unities abgeben:
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 |
KraBBy Mitglied Maschinenbau-Ingenieur
Beiträge: 601 Registriert: 19.09.2007 Inventor Professional 2020 WinX
|
erstellt am: 27. Jun. 2019 08:40 <-- editieren / zitieren --> Unities abgeben: Nur für Honigbär
|
| Konstrukteur für die Auftragssachbearbeitung von Treppenliftanlagen (m/w/d) | Wir sind Deutschlands größter Hersteller von Treppenliften und Marktführer bei Homeliften. Mit unseren Produkten helfen wir Menschen, damit sie besser leben können. Entscheiden Sie sich für HIRO, entscheiden Sie sich für einen starken Zusammenhalt im Team, eine spannende Aufgabe, einen sicheren Job und eine Karriere, die Sie selbst in der Hand haben. Bei HIRO werden Sie herzlich aufgenommen ... | Anzeige ansehen | Konstruktion, Visualisierung |
|
KraBBy Mitglied Maschinenbau-Ingenieur
Beiträge: 601 Registriert: 19.09.2007 Inventor Professional 2020 WinX
|
erstellt am: 27. Jun. 2019 13:17 <-- editieren / zitieren --> Unities abgeben: Nur für Honigbär
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 |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|