Herstel van macrowaarden van een sensor uit de verschillende configuraties

Hallo

Ik probeer een macro te maken die de waarde van een sensor en een specifieke eigenschap (opmaak genoemd) van elke configuratie ophaalt en die een gebruikersformulier opent met een array met 2 kolommen.

Opmaak |   Sensor

 

Kun je me alsjeblieft helpen?

Bedankt

Hallo

Voor sensoren kijk je naar dit voorbeeld waarmee je de waarde van een sensor kunt achterhalen.

https://help.solidworks.com/2020/English/api/sldworksapi/Get_and_Set_Sensor_Example_VB.htm?verRedirect=1

Om de configuraties op te sommen, 2 voorbeelden:

http://help.solidworks.com/2020/English/api/sldworksapi/Get_List_Of_Configurations_Example_VB.htm?verRedirect=1

http://help.solidworks.com/2017/English/api/sldworksapi/Change_Configuration_Properties_Example_VB.htm

Dan heb ik mijn twijfels of vanavond haalbaarder kan zijn in een userform of in het slechtste geval export naar Excel.

Hallo

Bedankt, ik kijk hier naar en ja, inderdaad, ik ben op zoek om het te openen in een useform en niet in een msg-box

Nogmaals bedankt voor de voorbeelden

Edit: de code voor de sensoren werkt helaas niet

Ik heb het net voor mij getest, het werkt, je hebt een open kamer nodig. En een sensor die al is gemaakt en geselecteerd voordat deze wordt gestart.

Ah! 

Heeft iemand de oplossing om te voorkomen dat u de sensor moet selecteren?

Ik keek een beetje op mijn zij maar helaas loop ik vast.

Bedankt

Hier is een 1e link met code om alle sensoren op te sommen, het werkt gedeeltelijk, maar het kan een goede voorsprong geven:

https://www.eng-tips.com/viewthread.cfm?qid=468348

'https://www.eng-tips.com/viewthread.cfm?qid=468348
Option Explicit
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swPart As SldWorks.PartDoc
    Dim swModel As SldWorks.ModelDoc2
    Dim swFeat As SldWorks.Feature
    Dim swSubFeat As SldWorks.Feature
    Dim swSensor As SldWorks.Sensor
    Dim swDimSensor As SldWorks.DimensionSensorData
    Dim sensorValue As Double
    Dim text As String

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swFeat = swModel.FirstFeature

    Do While Not swFeat Is Nothing
    Debug.Print "swFeat.Name" & swFeat.Name
        If (swFeat.Name = "Capteurs") Then
            Set swSubFeat = swFeat.GetFirstSubFeature
            Do While Not swSubFeat Is Nothing
                Set swSensor = swSubFeat.GetSpecificFeature2
                'Mis en commentaire car ne fonctionne pas
                'swDimSensor = swSubFeat.GetSensorFeatureData
                'sensorValue = swDimSensor.sensorValue

                Debug.Print swSensor.Name & ": " & sensorValue
                Set swSubFeat = swSubFeat.GetNextSubFeature
            Loop
        End If
        Set swFeat = swFeat.GetNextFeature
    Loop
    MsgBox (text)
End Sub

Hier is ook een koppeling met code in C++, je zult de vertaling in vba moeten doen maar het principe is er:

https://r1132100503382-eu1-3dswym.3dexperience.3ds.com/#community:yUw32GbYTEqKdgY7-jbZPg/iquestion:jpK7Vvu2QlugstMincAFoQ