Macro solidworks - Gezichtsselectie en kleur opleggen

Out of category
1

Hallo, ik kan geen gezicht selecteren en er vervolgens een kleur op leggen in mijn macro. Ik heb bedacht hoe ik het voor een functie moet doen, maar het lukt me niet om de code aan te passen om het voor één kant te laten werken. Probeer je hoe je het moet doen?

Hier is de code voor wie voor een functie werkt: 
 

            boolstatus = Part.Extension.SelectByID2("Song Before", "BODYFEATURE", 0, 0, 0, True, 0, Nothing, 0)

        Stel swSelMgr = swModel.SelectionManager in
        Stel swFeat in = swSelMgr.GetSelectedObject6(1, -1)
        vMatPrps = GetFeatureColor(swFeat)

            vMatPrps(0) = 1
            vMatPrps(1) = 1
            vMatPrps(2) = 1
            swFeat.SetMaterialPropertyValues2 vMatPrps, swInConfigurationOpts_e.swThisConfiguration, ""
            swModel.ClearSelection2 Waar

En hier is het gezicht dat ik wil selecteren:

boolstatus = Part.Extension.SelectByID2("", "GEZICHT", -0.128447455152696, 1.8250000000000516E-02, -7.95118360022116E-02, Onwaar, 0, Niets, 0)

Bij voorbaat dank.

2

de declaratie van variabelen, indien nodig:

Dim swApp als SldWorks.SldWorks
Dim swModel als SldWorks.ModelDoc2
Dim swModelExt als ModelDocExtension
Dim deel als SldWorks.PartDoc
Dim swConfig als SldWorks.Configuration
Dim boolstatus als Booleaanse
Zon swSelMgr As SldWorks.SelectionMgr
Dim swFeat als SldWorks.Feature

Dim vMatPrps als variant

3

Hallo. Probeer het volgende:

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 vProp As Variant
    Dim bRet As Boolean
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    If swModel Is Nothing Then MsgBox "Ouvrir une pièce": Exit Sub
    If swModel.GetType <> swDocumentTypes_e.swDocPART Then MsgBox "Ouvrir une pièce": Exit Sub
    If swSelMgr.GetSelectedObjectCount2(-1) = 0 Then MsgBox "Sélectionner une face": Exit Sub
    Set swFace = swSelMgr.GetSelectedObject6(1, -1)
    vProp = swFace.MaterialPropertyValues
    If IsEmpty(vProp) Then vProp = swModel.MaterialPropertyValues
    Debug.Print "Couleur courante: (" & vProp(0) * 255# & ", " & vProp(1) * 255# & ", " & vProp(2) * 255# & ")"
    bRet = swModel.SelectedFaceProperties(RGB(0, 255, 0), vProp(3), vProp(4), vProp(5), vProp(6), vProp(7), vProp(8), False, "")
    swModel.ClearSelection2 True
End Sub

 

1 like
4

Bedankt JeromeP, het is precies wat ik wilde 

5

Is het mogelijk om meerdere gezichten te selecteren en vervolgens de macro te starten om de kleur in te voeren, of moet je gezicht voor gezicht staan zoals de huidige code?

6

Is het mogelijk om meerdere gezichten te selecteren en vervolgens de macro te starten, of moet je het face voor face doen zoals de huidige code?

7

@JeromeP 

Is het mogelijk om meerdere gezichten te selecteren en de macro uit te voeren, of moet je face voor face kijken zoals de huidige code?

8

Alles is mogelijk!

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 swEnt As SldWorks.Entity
    Dim vProp As Variant
    Dim bRet As Boolean
    Dim i As Integer
    Dim vFaces As New Collection
    Dim vFace As Variant
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    If swModel Is Nothing Then MsgBox "Ouvrir une pièce": Exit Sub
    If swModel.GetType <> swDocumentTypes_e.swDocPART Then MsgBox "Ouvrir une pièce": Exit Sub
    If swSelMgr.GetSelectedObjectCount2(-1) = 0 Then MsgBox "Sélectionner une face": Exit Sub
    For i = 1 To swSelMgr.GetSelectedObjectCount2(-1)
        vFaces.Add swSelMgr.GetSelectedObject6(i, -1)
    Next
    For Each vFace In vFaces
        Set swFace = vFace
        Set swEnt = swFace
        vProp = swFace.MaterialPropertyValues
        If IsEmpty(vProp) Then vProp = swModel.MaterialPropertyValues
        Debug.Print "Couleur courante: (" & vProp(0) * 255# & ", " & vProp(1) * 255# & ", " & vProp(2) * 255# & ")"
        swEnt.Select4 False, Nothing
        bRet = swModel.SelectedFaceProperties(RGB(0, 255, 0), vProp(3), vProp(4), vProp(5), vProp(6), vProp(7), vProp(8), False, "")
    Next vFace
    swModel.ClearSelection2 True
End Sub

 

3 likes
9

Ik denk nooit aan krullen, toch bedankt:)

10

Hoe gebruik ik deze code zonder de oppervlakken te hoeven selecteren, maar met behulp van een selectieset?