Witam, nie mogę wybrać twarzy, a następnie nałożyć na nią koloru w moim makrze. Wymyśliłem, jak to zrobić dla funkcji, ale nie mogę zmodyfikować kodu, aby działał dla jednej strony. Próbujesz jak to zrobić?
Oto kod określający, kto pracuje dla funkcji:
boolstatus = Part.Extension.SelectByID2("Piosenka przed", "BODYFEATURE", 0, 0, 0, Prawda, 0, Nic, 0)
Ustaw swSelMgr = swModel.SelectionManager
Ustaw swFeat = swSelMgr.GetSelectedObject6(1, -1)
vMatPrps = GetFeatureColor(swFeat)
vMatPrps(0) = 1
vMatPrps(1) = 1
vMatPrps(2) = 1
swFeat.SetMaterialPropertyValues2 vMatPrps, swInConfigurationOpts_e.swThisConfiguration, ""
swModel.ClearSelection2 Prawda
A oto twarz, którą chcę wybrać:
boolstatus = Part.Extension.SelectByID2("", "TWARZ", -0.128447455152696, 1.8250000000000516E-02, -7.95118360022116E-02, Fałsz, 0, Nic, 0)
Z góry dziękuję.
deklarację zmiennych, jeśli to konieczne:
Dim swApp jako SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelExt As ModelDocExtension
Przyciemnij część jako SldWorks.PartDoc
Dim swConfig jako SldWorks.Configuration
Dim boolstatus As Boolean
Sun swSelMgr jako SldWorks.SelectionMgr
Dim swFeat As SldWorks.Feature
Dim vMatPrps jako wariant
Witam. Spróbuj tego:
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 polubienie
Dziękuję JeromeP to jest dokładnie to, czego chciałem
Czy można wybrać kilka twarzy, a następnie uruchomić makro, aby umieścić kolor, czy też musisz to zrobić twarzą w twarz, tak jak w obecnym kodzie?
Czy można wybrać kilka twarzy, a następnie uruchomić makro, czy też trzeba to zrobić twarzą w twarz, tak jak w obecnym kodzie?
@Hieronim P
Czy można wybrać kilka powierzchni i uruchomić makro, czy też trzeba to zrobić twarzą w twarz, tak jak w bieżącym kodzie?
Wszystko jest możliwe!
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 polubienia
Nigdy nie myślę o lokach, i tak dziękuję :)
Jak użyć tego kodu bez konieczności wybierania powierzchni, ale przy użyciu zbioru wskazań?