Macro als eigenschap = "X"

Hallo

Ik heb een macro die willekeurige kleuren toewijst aan onderdelen van een assemblage.

Ik zou graag willen dat deze macro alleen van toepassing is op de component met een aangepaste eigenschap "component family" = "1"

Hieronder is mijn code:

Dim vMatProp As Variant

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
vMatProp = swModel.MaterialPropertyValues

'Get all elements
If swModel.GetType = swDocPART Then
   vElementArr = swModel.GetBodies2(swAllBodies, False)

       For Each vElement In vElementArr
           Set swElement = vElement
           Randomize
           vMatProp(0) = Rnd 'Red
           vMatProp(1) = Rnd - 255 'Green
           vMatProp(2) = Rnd 'Blue
           vMatProp(3) = Rnd / 2 + 0.5 'Ambient
           vMatProp(4) = Rnd / 2 + 0.5 'Diffuse
           vMatProp(5) = Rnd 'Specular
           vMatProp(6) = Rnd * 0.9 + 0.1 'Shininess
           swElement.MaterialPropertyValues2 = vMatProp
       Next

ElseIf swModel.GetType = swDocASSEMBLY Then
   vElementArr = swModel.GetComponents(True)

       For Each vElement In vElementArr
           Set swElement = vElement
           Randomize
           vMatProp(0) = Rnd * 0.05 + 0.95 'Red
           vMatProp(1) = 0.77 * Rnd + 0.05  'Green
           vMatProp(2) = (1 - 2 * Abs(0.45 - vMatProp(1))) * Rnd + 2 * Abs(0.45 - vMatProp(1))   'Blue
           vMatProp(3) = Rnd / 2 + 0.5 'Ambient
           vMatProp(4) = Rnd / 2 + 0.5 'Diffuse
           vMatProp(5) = Rnd 'Specular
           vMatProp(6) = Rnd * 0.9 + 0.1 'Shininess
           swElement.MaterialPropertyValues = vMatProp
       Next

ElseIf swModel.GetType = swDocDRAWING Then
   MsgBox ("You can only apply random colors to part bodies or assembly components.")
   Exit Sub

End If

'Redraw to see new color
swModel.GraphicsRedraw2

End Sub

 

Kijk op deze link:

http://help.solidworks.com/2020/English/api/sldworksapi/Get_Custom_Properties_of_Referenced_Part_Example_VB.htm

U zou in staat moeten zijn om de informatie die u wilt ophalen en een extra voorwaarde aan uw eigendom toe te voegen

Dank je wel sbadenis

Allereerst heb ik de hele eerste sectie "If swModel.GetType = swDocPART Then" gebruikt, die ik niet gebruik (ik werk op assembly-niveau)

vervolgens, in de lijst van "Dim", de regel

Dim swCustProp als CustomPropertyManager


dan, in plaats van "Alle elementen ophalen", plak ik

' Haal de aangepaste eigenschapsgegevens op
Set swCustProp = swModelDocExt.CustomPropertyManager("")
bool = swCustProp.Get4("Property_Name", False, val, valout)

Ik vervang "Property_Name" door "Componentenfamilie"

Maar waar geef ik de waarde "1" op die ik zoek voor deze woning?

 

Hallo

Bij een tweede type behandeling:

If Valout = "1" then
 xxx
End if

 

Hallo

Probeer het met deze code:

Dim swApp As Object

Sub main()

Dim swModel As ModelDoc2
Dim swModel2 As ModelDoc2
Dim vMatProp As Variant
Dim swCustProp As CustomPropertyManager
Dim val As String
Dim valout As String
Dim bool As Boolean

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
vMatProp = swModel.MaterialPropertyValues

If swModel.GetType = swDocPART Then
    MsgBox ("Cette macro n'est à utiliser que sur les assemblages.")
    Exit Sub

ElseIf swModel.GetType = swDocASSEMBLY Then
    vElementArr = swModel.GetComponents(True)
    For Each vElement In vElementArr
        Set swElement = vElement
        Set swModel2 = swElement.GetModelDoc2
        Set swCustProp = swModel2.Extension.CustomPropertyManager("")
        bool = swCustProp.Get4("famille de composant", False, val, valout)
        If valout = "1" Then
            Randomize
            vMatProp(0) = Rnd * 0.05 + 0.95 'Red
            vMatProp(1) = 0.77 * Rnd + 0.05  'Green
            vMatProp(2) = (1 - 2 * Abs(0.45 - vMatProp(1))) * Rnd + 2 * Abs(0.45 - vMatProp(1))   'Blue
            vMatProp(3) = Rnd / 2 + 0.5 'Ambient
            vMatProp(4) = Rnd / 2 + 0.5 'Diffuse
            vMatProp(5) = Rnd 'Specular
            vMatProp(6) = Rnd * 0.9 + 0.1 'Shininess
            swElement.MaterialPropertyValues = vMatProp
        End If
    Next

ElseIf swModel.GetType = swDocDRAWING Then
    MsgBox ("Cette macro n'est à utiliser que sur les assemblages.")
    Exit Sub

End If

swModel.GraphicsRedraw2

End Sub

Vriendelijke groeten

3 likes

  @ Cyril.f:

in plaats van "ElseIf swModel.GetType = swDocASSEMBLY Then"

Ik plak "Als Valout = "1" dan"

Resultaat: Compilatiefout on line

bool = swCustProp.Get4("Component Familie", False, Val, Valout) 

Val is een "niet-optioneel argument"

 

@ D.Roger:

Geen vergissing, maar er gebeurt niets op mijn montage...

Het is jammer, want voor een keer is de code begrijpelijk op mijn beginnersniveau en kan ik deze aanpassen om de macro te laten evolueren

Een andere vraag trouwens, wat moet ik veranderen als ik de kleur op onderdeelniveau wil toepassen en niet op het niveau van de assemblagecomponent?

Om de waarde van de variabele op het onderdeel op te halen, moet deze worden beschouwd als geladen in Solidworks, dus in opgeloste modus, is dit het geval in uw assemblage?

Vriendelijke groeten

En ik denk dat ik kan antwoorden in plaats van @Cyril.f , hij heeft je nooit verteld om "ElseIf swModel.GetType = swDocASSEMBLY Then" te vervangen door "If Valout = "1" then", maar beantwoordde je vraag "Maar waar specificeer ik de waarde "1" op zoek naar deze eigenschap?". De oplossing die hij geeft is precies dezelfde als de mijne, maar dan zonder het concrete voorbeeld...

Voor de opmerking "Val is een "niet-optioneel argument", betekent dit dat je je variabele niet "typt", dus zet een regel "Dim Val als String" voor ... Hetzelfde geldt natuurlijk voor de variabele "valout ".

Een ander punt, met de regels:

Stel swCustProp in = swModel2.Extension.CustomPropertyManager("")

bool = swCustProp.Get4("component familie", False, val, valout)

Als valout = "1" Dan

Dit betekent dat de aangepaste eigenschap Componentfamilie moet worden genoemd, dat de geëvalueerde waarde 1 moet zijn en dat deze op het tabblad Aanpassen moet staan. Als het wordt gevonden in de aangepaste eigenschappen die specifiek zijn voor de configuratie , is het niet helemaal dezelfde code die nodig is, omdat u de naam van de configuratie moet opgeven waarin u naar de waarde moet zoeken, zoals de configuratie met de naam Standaard in de volgende regel:

Stel swCustProp = swModel2.Extension.CustomPropertyManager("Standaard").

Vriendelijke groeten

1 like

@d.roger , je hebt er goed aan gedaan om voor mij te antwoorden. Voor de rest ben ik het volledig eens met je analyse.          

1 like

Bedankt voor de gedetailleerde en didactische antwoorden;)

Ik heb het net geprobeerd met de voorgestelde code, zonder iets toe te voegen, en, oh vreugde, het werkt... Ik weet niet waar ik het bij mijn eerste poging heb verpest. Sorry voor het in twijfel trekken van uw expertise.

Ik zal proberen een regel toe te voegen om de delen te veranderen in opgelost.

Tot slot, heb je een idee om kleur aan te brengen op het niveau van het onderdeel en niet op het assemblageonderdeel?

 

Hallo

Mijn macro leek prima te werken op mijn testassemblage, maar op andere assemblages loopt hij vast op de lijn        

Stel swCustProp in = swModel2.Extension.CustomPropertyManager("")

"Fout 91: Objectvariabele of Met blokvariabele niet gedefinieerd"

Hallo

Zoals al eerder gezegd:

"Om de waarde van de variabele op het onderdeel op te halen, moet het worden beschouwd als geladen in Solidworks, dus in de opgeloste modus, is dit het geval in uw assemblage?"

Vriendelijke groeten

Ja ja, alles is opgelost.

Het kan dus zijn dat het afkomstig is van een onderdeel dat in een verwijderde staat is...

Maar hoe dan ook, het komt uit de lijn:

"Stel swModel2 = swElement.GetModelDoc2 in"

die crasht omdat de macro om de een of andere reden (lite-modus, verwijderde status, ...) de ModelDoc2 van een component niet vindt, wat een fout van dit type retourneert. Ik zie dat de foutafhandeling niet is gedaan :-) ... Ter herinnering: de hier gegeven macro's zijn slechts bijvoorbeeld en moeten worden herwerkt om op zijn minst foutafhandeling toe te voegen...

Vriendelijke groeten

Inderdaad, er zijn...

Voeg in ieder geval de regel toe:

"Bij fout volgende hervatten"

Net onder de lijn:

"Voor elk vElement in vElementArr"

Dit heeft tot gevolg dat de lus wordt voortgezet, zelfs als de macro op een fout terechtkomt.

Zie HIER.

Vriendelijke groeten

1 like

Perfect, het werkt perfect!

Om het ding te verbeteren, ga ik proberen een regel in te voegen om alles in de opgeloste modus te zetten. Ik heb deze functie gevonden: "LightweightAllResolved". Ik zal proberen het in te voegen, idealiter met een dialoogvenster om te bevestigen.

En de terugkerende vraag: als ik kleur wil aanbrengen op onderdelen in plaats van componenten, heb ik een vermoeden dat ik deze lijn moet vervangen
vElementArr = swModel.GetComponents

door een of andere chode van het soort
Stel swCompModel = swApp.ActivateDoc in (of ActiveerDoc2 of ActiveerDoc3...?)
Ben ik op de goede weg?