---

Hallo zusammen,

ich suche ein Makro mit dem man einer markierten Fläche oder Feature in einem Part eine andere Farbe zuweisen kann.

Habe schon einige Beiträge über ähnliche Anwendungsbeispiele gelesen, mir daraus etwas zu stricken übersteigt aber meine Fähigkeiten gewaltig.

Kann mir Jemand einen Tip geben ob es ein solches Makro, oder ähnliches, schon gibt ?

Vielleicht geht das ja auch mit mehreren Fächen oder Features, oder soger Flächen und Features !?

Danke im voraus

Martin

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

---

Ich glaube nicht, das du dir mit so einem Makro auch nur einen Klick sparst!

------------------
...strebe niemals nach den Dingen, die auch dümmeren gelingen.....

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

---

Hallo Wolfram,

in gewisser Weise stimme ich dir da zu, nur diese Anfrage kommt von mehreren Kollegen,

und was tut man nicht alles für die. 

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

---

....ich denke, da wird sich sicher noch ein Makrospezialist zu Wort melden!

------------------
...strebe niemals nach den Dingen, die auch dümmeren gelingen.....

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

---

Hallo Martin,

in der API Hilfe gibt es ein Beispiel namens "Change Color of Face Example (VBA)", wenn dein Kollege das wirklich unbedingt haben will soll er sich das eben in ein neues Makro reinkopieren.

Zitat:

---

Original erstellt von Olaf Wolfram:
....ich denke, da wird sich sicher noch ein Makrospezialist zu Wort melden!

---

Also ich zumindest nicht. Ich programmiere zwar gerne und auch manchmal einfach aus Spaß, aber einen Sinn möchte ich schon darin sehen und die Überzeugung entweder jemandem damit ein Beispiel zu geben, wie es gemacht wird (das ist in diesem Fall nicht notwendig, weil es so ein Beispiel in der API Hilfe gibt) oder weil es einem Anwender hilft und ich vermute, dass es auch von anderen gebraucht werden könnte.

Das zweite sehe ich auch nicht: wie oft kann man so ein Makro brauchen? Sagen wir 2 mal pro Tag. Wieviele verschiedene Farben brauchst du und infolgedessen wieviele Makros? Sagen wir mal 5. Ich könnte mit einem Makro 2 Klicks sparen, also ca. 4 Sekunden pro Tag. Um die 5 Makros zu erstellen bräuchte ich ca. 30 Minuten. D.h. erst nach 450 Arbeitstagen würden sich das Makro bezahlt machen ... mit dem kleinen Beigeschmack, dass ich die Arbeit damit hätte und ein Anderer damit nicht weiter über die Bordmittel und deren Einsatz nachdenken braucht und das ggf. beim nächsten Patch oder Update nicht mehr braucht. Hört sich für mich nicht nach einer interessanten Aufgabe an   

Wenn es nur um die Klickminimierung geht würde ich vorschlagen eigene Farben in die Erscheinungsbildtaskpane abzulegen und die einfach per Dragdrop auf die jeweilige Fläche zu ziehen.

Ciao,
Stefan

------------------
Inoffizielle deutsche SolidWorks Hilfeseite    http://solidworks.cad.de
Stefans SolidWorks Blog

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

---

Hallo Stefan,

erst mal danke für den Hinweis.

Wissen  =  wenn man weiß wo alles steht 

Für eine Fläche klappts, vielleicht hast du ja noch ne Idee wie es mit mehreren markierten Flächen in einem Part geht.

Ich stimme dir im Großen und Ganzen zu, besonders amüsant finde ich das Rechenbeispiel der Arbeitsersparnis.

Ich habe vor einem Jahr die Aufgabe der Softwarebetreuung bekommen und wurschtle mich seit dem so durch.

z.B. Vorlagen für Modelle und Zeichnungen verschiedener Kunden betreuen und erstellen, Dateieigenschaften ausfüllen, automatische Stücklistenerstellung ect. ect.

Seit ich dein Makro für die Dateieigenschaften eingeführt und angepasst habe, schreit naturlich jeder nach "mehr".

Nach dem die Zeichner einige erhebliche Erleichterungen bekommen haben, gehen die Konstrukteure jetzt langsam auf die Barrikaden. 

Teilweise ein echt undankbarer Job.

grüße aus Aschaffenburg

Martin

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

---

Hallo Stefan,

habe das Beispiel ausprobiert.

3 Fragen hätt ich noch:

Wenn keine Fläche markiert ist, dann kommt ein Fehler (Debuggen siehe unten)
Kann man das mit einer Meldung (z.B. Msgbox) "keine Fläche gewählt" und dann ENDE abfangen?

Als zweites, geht es auch mit mehren markierten Flächen ?
Kann ja sein das in einem Modell mehr als eine Fläche eingefärbt werden soll.

Und letzteres, wenn ich die mit "_" gekennzeichneten Zeilen deaktiviere, gehts ohne Fehler,
wenn nichts markiert ist wird auch nichts eingefärbt.
Sind das die originalen Werte die ausgelesen werden, und braucht man die unbedingt ?

  '-----------------------------------------------------
    ' Voraussetzungen:
    '    (1) Teil oder Baugruppe ist offen
    '    (2) Fläche ist markiert
    '------------------------------------------------------

Option Explicit

Sub main()

    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swFace As SldWorks.Face2
    Dim vFaceProp As Variant
    Dim bRet As Boolean

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    Set swFace = swSelMgr.GetSelectedObject5(1)
 
 
_  vFaceProp = swFace.MaterialPropertyValues
    ## Fehler wenn keine Fläche selektiert #

_  If IsEmpty(vFaceProp) Then
        ' Is empty if face-level colors were not specified, so get them from underlying model
_      vFaceProp = swModel.MaterialPropertyValues: Debug.Assert Not IsEmpty(vFaceProp)
_  End If

   

    'Current Color

_  Debug.Print "RGB            = [" & vFaceProp(0) * 255# & ", " & vFaceProp(1) * 255# & ", " & vFaceProp(2) * 255# & "]"
_    Debug.Print "Ambient        = " & vFaceProp(3)
_    Debug.Print "Diffuse        = " & vFaceProp(4)
_    Debug.Print "Specular      = " & vFaceProp(5)
_    Debug.Print "Shininess      = " & vFaceProp(6)
_    Debug.Print "Transparency  = " & vFaceProp(7)
_    Debug.Print "Emission      = " & vFaceProp(8)

    ' New color

    bRet = swModel.SelectedFaceProperties(RGB(255, 0, 0), (1), (1), (1), (0.3), (0), (0), False, "")    _: Debug.Assert bRet
       
       
    ' Deselect face to see new color

    swModel.ClearSelection2 True

End Sub
'-------------------------------------------------------

Danke

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

---

Hallo Martin,

Zitat:

---

Original erstellt von Joshua63:
Wenn keine Fläche markiert ist, dann kommt ein Fehler (Debuggen siehe unten)
Kann man das mit einer Meldung (z.B. Msgbox) "keine Fläche gewählt" und dann ENDE abfangen?

---

Klar, du kannst mit SelectionMgr::GetSelectedObjectCount2 herausfinden, wie viele Objekte selektiert sind, wenn 0 = nichts selektiert. Wenn du es ganz sicher machen willst überprüfst du noch mit SelectionMgr::GetSelectedObjectType3 ob auch eine Fläche selektiert wurde.

Zitat:

---

Original erstellt von Joshua63:
Als zweites, geht es auch mit mehren markierten Flächen ?
Kann ja sein das in einem Modell mehr als eine Fläche eingefärbt werden soll.

---

Ja, siehe oben. Du klapperst in einem Loop alle Flächen ab und holst dir jeweils mit swSelMgr.GetSelectedObject5(Nummer) eben nicht das erste selektierte Objekt, sondern nacheinander alle, ungefähr so:

Code:

---

For i = 1 to swSelMgr.GetSelectedObjectCount2
Set swFace = swSelMgr.GetSelectedObject5(i)
next i

---

So was in der Art ...

Zitat:

---

Original erstellt von Joshua63:
Und letzteres, wenn ich die mit "_" gekennzeichneten Zeilen deaktiviere, gehts ohne Fehler,
wenn nichts markiert ist wird auch nichts eingefärbt.
Sind das die originalen Werte die ausgelesen werden, und braucht man die unbedingt ?

---

Ich versteh deine Frage leider nicht ganz. Wenn du nichts selektiert hast wird durch die Zuweisung in Set swFace = swSelMgr.GetSelectedObject5(1) logischerweise Nichts an die Fläche zugewiesen (die ist also anschließend nicht Empty = leer, sondern Nothing = Nichts  ). Wenn du dann versuchst die Materialwerte von Nichts auszulesen bekommst du einen vor die Waffel. Die Originalen werte solltest du aber schon vorher auslesen, zum einen ist das Initialisieren des Safearrays direkt erledigt, zum anderen kannst du dann die anderen Werte übernehmen, die durch deine Zuweisung nicht geändert werden sollen, wenn du z.B. nur die Farbe ändenrn willst, aber nicht die Transparenz oder die Emission oder so.

Ciao,
Stefan

------------------
Inoffizielle deutsche SolidWorks Hilfeseite    http://solidworks.cad.de
Stefans SolidWorks Blog

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

---

Hallo Stefan,

danke für die Hilfe, hat so weit erst mal geklappt.

Werde noch ein wenig damit experementieren...

Vielleicht kommt ja noch die ein oder andere Frage von mir 

ciao
Martin

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

---

Hallo Stefan,

ich war leider etwas voreilig.

Es klappt natürlich nur für eine Fläche, hab es leider nicht hin bekommen allen markierten Flächen die neue Farbe zu zu zuweisen.

Kannst du mir da noch einmal helfen ?

Sub main()

    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swFace As SldWorks.Face2
    Dim vFaceProp As Variant
    Dim bRet As Boolean
    Dim i As Integer
       
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    Set swFace = swSelMgr.GetSelectedObject5(i)
   
       
    Count = swSelMgr.GetSelectedObjectCount2(-1)
   
    For i = 1 To swSelMgr.GetSelectedObjectCount2(i)
    Set seFace = swSelMgr.GetSelectedObject5(i)
    Next i
   
    If Count < "1" Then
    Call MsgBox("Keine Fläche markiert!", vbOKOnly + vbExclamation, "                  INFORMATION      ")
        End
    End If
   
    ' New color

## Hier müsste doch auch eine Schleife rein, oder ?
   
    bRet = swModel.SelectedFaceProperties(RGB(255, 0, 0), (1), (1), (1), (0.3), (0), (0), False, "")
     
    swModel.ClearSelection2 True

End Sub

Ist der Rest soweit Ok?

Danke
Martin

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

---

Hallo Martin,

Zitat:

---

Original erstellt von Joshua63:
Ist der Rest soweit Ok?

---

Nein, mehrere Sache sind nicht richtig. Wie schon an anderer Stelle geschrieben musst du als Programmierer erst einmal verstehen, dass der Computer blind, taub und total blöde ist. Ein Makro kann nicht ahnen, was du möchtest, es kann nicht sehen, wo du hinklickst und es kann nicht hören, wenn du sagst Na klick da auf den Button. An jede Kleinigkeit musst du selber denken und dem Dummie jeden kleinsten Schritt in der richtigen Reihenfolge vorkauen. Und dabei ist die SolidWorks API und VBA ja noch eine sogenannte Hochsprache, der sehr viele intelligente und mächtige Befehle hat, die fast alles von alleine tun ;)

Zunächst: du holst dir in der Zeile Count = swSelMgr.GetSelectedObjectCount2(-1) die Anzahl der selektierten Objekte, so weit so gut. Count ist nicht deklariert, das macht VBA zwar implizit, ist aber kein guter Stil. Also gehörte irgendwo im Deklarationsbereich noch so etwas wie Dim Count as Long rein.

Dann durchläufst du direkt danach die Schleife und weist einer (ebenfalls nicht deklarierten) Variable seFace das entsprechende selektierte Objekt zu. Ich vermute a) einen Schreibfehler (sollte wohl swFace heißen) und b) ein kaltes Büro, weil du damit eine Heizschleife gebaut hast. Okay, ist etwas gemein, aber was willst du mit der Schleife erreichen? So wird nur die CPU beschäftigt ... ;)

Erst dann schaust du, ob überhaupt was selektiert warst, dass könntest du direkt erledigen, sobald du die Anzahl geholt hast.

Zitat:

---

Original erstellt von Joshua63:
Es klappt natürlich nur für eine Fläche, hab es leider nicht hin bekommen allen markierten Flächen die neue Farbe zu zu zuweisen.

---

Na ja, du weist ja auch wieder der zuletzt selektierten Fläche die Farbe Rot zu. Die Funktion heißt ja SelectedFaceProperties. Um das also über alle selektierten Flächen zu machen musst du also nacheinander die Flächen anspringen (wie in der Heizschleife oben) und mit MaterialProperty die Werte zuweisen oder dir alle Flächen der Selektion merken, nacheinander wieder einzeln selektieren und mit dem SelectedFaceProperties die Farbe zuweisen.

Wie gesagt: denk in kleinen Schritte, ich finde es beim Makroprogrammieren einfacher von hinten (gewünschtes Ergebnis) schrittweise nach vorne (wie komm ich dahin) zu denken, aber das ist Übungssache. Man muss sich nur immer vor Augen halten dass ein Computer strohdumm ist. Was du als Anwender eines Programms gewöhnt bist kannst du als Programmierer meist vergessen und musst selber an all die kleinen Fallstricke denken. Das tut in meinen Augen durchaus der Seele gut und man weiß die Programme und Tools, vor allem die komplexen wie SolidWorks, viel besser zu schätzen. Selbst wenn das Profis sind, die dafür bezahlt werden ist es sehr schwierig, in diesen ganz kleinen Schritten für ein so gewaltiges System zu denken.

A propos bezahlen: ich vermute du kommst langsam dahinter, was ich oben damit meinte, ob es sich wirklich lohnt für ein  2-Klick-Einspar-Makro solch einen Aufwand zu betreiben. Da sich das ganze mehr zu einem Lehrbeispiel entwickelt hat bin ich noch dabei, das ist aber auch der einzige Grund.

Ich hab das mal etwas umgebaut, wie ich es auf dieser Basis machen würde: wenn nichts selektiert ist raus, dann alle Flächen merken. Das mach ich in einer Collection (Sammlung), das ist sehr bequem, wenn man nicht weiß, wie viele Objekte kommen.

Anschließend wird eine gemerkte Fläche nach der anderen selektiert und farblich zugewiesen.

Code:

---

Sub main()

    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swSelMgr As SldWorks.SelectionMgr
   
    Dim swFaces As New Collection
    Dim swFace As SldWorks.Face2
    Dim vFaceProp As Variant
    Dim bRet As Boolean
    Dim i As Integer
       
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    Set swFace = swSelMgr.GetSelectedObject5(i)
   
       
    Count = swSelMgr.GetSelectedObjectCount2(-1)
   
    ' zuerst mal abfragen, ob überhaupt was selektiert war
    If Count < "1" Then
    Call MsgBox("Keine Fläche markiert!", vbOKOnly + vbExclamation, "                  INFORMATION      ")
        End
    End If
   
    ' dann die Schleife über alle selektierten Objekte und diese merken
    For i = 1 To Count
        ' das nächste selektierte Objekt holen (hoffentlich alle snur Flächen)
        Set swFace = swSelMgr.GetSelectedObject5(i)
        ' und in derCollection merken
        swFaces.Add swFace
    Next i
   
    ' und nacheinander alle gemerkten Flächen wieder selektieren
    ' und mit den gewünschten Materialproperties versehen
    For Each swFace In swFaces
        swFace.Select False
        bRet = swModel.SelectedFaceProperties(RGB(255, 0, 0), (1), (1), (1), (0.3), (0), (0), False, "")
    Next

    ' die vorhandene Selektion vergessen
    swModel.ClearSelection2 True

End Sub

---

Ach ja, du siehst vielleicht hier auch wie wichtig es ist Quellcode zu kommentieren; es macht es einem selber leicht zu denken, wenn man schriftlich formuliert, was man eigentlich vor hat, es ist gut für den programmierer selbst, wenn man in 6 Monaten oder 2 Jahren da noch mal ran muss und gut für jeden anderen, der den Code lesen muss und verstehen soll, was gewünscht ist.

So, genug gespielt (und gelästert  ) für heute morgen.

Ciao,
Stefan

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

---

Hallo Stafan,

klappt super (wie erwartet) 

Du hattest recht, das eine war ein Schreibfehler.

Ich bin für Kritik aller Art offen, und Sarkasmus ist mein 2. Vorname, hab also ne dicke Haut.

Zitat:
__________________________________________________________________________________________
A propos bezahlen: ich vermute du kommst langsam dahinter, was ich oben damit meinte, ob es sich wirklich lohnt für ein  2-Klick-Einspar-Makro solch einen Aufwand zu betreiben.
Da sich das ganze mehr zu einem Lehrbeispiel entwickelt hat bin ich noch dabei, das ist aber auch der einzige Grund.
__________________________________________________________________________________________

Das Makro wird bei Fertigungsteilen von ca. 10 Konstrukteuren benutzt.
Klar reden wir hier nur (wenn überhaupt) von wenigen Minuten am Tag. Von einer Kostenersparnis keine Rede.
Es geht hier nur um reine Bequemlichkeit. Der Hintergrungd ist, durch die ganzen Mechanismen in SW die ich eingeführt habe (Dateieigenschaften in Zeichnungen übertragen, atom.Stüli erstellen, usw.) sind die Zeichner erheblich entlastet worden. Die Konstrukteure müssen jetzt ein bisschen mehr machen. Da musste ich nicht lange warten bis der erste mit Ideen und Wünschen für Erleichterungen kam.
Da es mir die momentane Auftraglage erlaubt hier ein wenig Zeit zu investieren, nutze ich das natürlich.

Deshalb bin ich auch heilfroh, das es Spezialisten wie dich gibt die sich mit Laien wie mich abgeben.

Ein Problem habe ich noch (wirst du erwartet haben) :

ist ein Feature markiert, bleibt das Makro natürlich bei diesem Eintrag hängen.

' das nächste selektierte Objekt holen (hoffentlich alles nur Flächen)
  Set swFace = swSelMgr.GetSelectedObject5(i)

Ich würde das gerne vermeiden.

vielleicht mit einer MsgBox "Nur Flächen markieren", oder das dem Feature auch die Farbe zugewiesen wird.

Ich hoffe ich strapaziere dein Gutmütigkeit nicht zu sehr.

danke
Martin

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

---

Hallo Martin,

Zitat:

---

Original erstellt von Joshua63:
Ein Problem habe ich noch (wirst du erwartet haben) :
ist ein Feature markiert, bleibt das Makro natürlich bei diesem Eintrag hängen.
' das nächste selektierte Objekt holen (hoffentlich alles nur Flächen)
  Set swFace = swSelMgr.GetSelectedObject5(i)
Ich würde das gerne vermeiden.

---

Wie schon oben geschrieben solltest du dann ggf. mit SelectionMgr::GetSelectedObjectType3 vorher abfragen, ob das selektierte Objekt tatsächlich eine Fläche ist. Das sieht dann so aus:

Code:

---

Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swSelMgr As SldWorks.SelectionMgr
   
    Dim swFaces As New Collection
    Dim swFace As SldWorks.Face2
    Dim vFaceProp As Variant
    Dim bRet As Boolean
    Dim i As Integer
       
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    Set swFace = swSelMgr.GetSelectedObject5(i)
   
       
    Count = swSelMgr.GetSelectedObjectCount2(-1)
   
    ' zuerst mal abfragen, ob überhaupt was selektiert war
    If Count < "1" Then
    Call MsgBox("Keine Fläche markiert!", vbOKOnly + vbExclamation, "                  INFORMATION      ")
        End
    End If
   
    ' dann die Schleife über alle selektierten Objekte und diese merken
    For i = 1 To Count
        ' das nächste selektierte Objekt holen
        ' und überprüfen on es eine Fläche ist
        If swSelMgr.GetSelectedObjectType(i) = swSelFACES Then
            Set swFace = swSelMgr.GetSelectedObject5(i)
            ' und in derCollection merken
            swFaces.Add swFace
        End If
    Next i
   
    ' und nacheinander alle gemerkten Flächen wieder selektieren
    ' und mit den gewünschten Materialproperties versehen
    For Each swFace In swFaces
        swFace.Select False
        bRet = swModel.SelectedFaceProperties(RGB(255, 0, 0), (1), (1), (1), (0.3), (0), (0), False, "")
    Next

    ' die vorhandene Selektion vergessen
    swModel.ClearSelection2 True

End Sub

---

Auf diese Art und Weise wird einfach alles, was nicht Fläche ist, ignoriert.

Zitat:

---

Original erstellt von Joshua63:
Ich hoffe ich strapaziere dein Gutmütigkeit nicht zu sehr.

---

Nein, kein Problem, ich hab im Laufe der letzten 10 Jahre hier im Brett durchaus gelernt "Nein" zu sagen oder gar nicht mehr zu antworten, wenn ich das Gefühl habe, dass ich nur die Arbeit für jemanden machen soll 

Ciao,
Stefan

------------------
Inoffizielle deutsche SolidWorks Hilfeseite    http://solidworks.cad.de
Stefans SolidWorks Blog

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

---

Hallo Stefan,

vielen Dank für den letzten Schliff.

Noch eine letzte Frage zu diesem Thema.

Es klappt bei allen markierten Flächen, egal ob normales Feature oder mit dem Bohrungsassistent erstellte Bohrungen und Formsenkungen.

Nur wenn mit dem Bohrungsassistent ein Gewinde mit Gewindedarstellung erzeugt wird, dann übernimmt er nix.

Gibt es dafür eine Erklärung ?
Ist doch auch eine normale Fläche, oder hat das etwas mit der Gewindedarstellung zu tun ?

Ciao
Martin

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