VBA Solidworks, pobieranie niestandardowej właściwości części

js_1207 · 2 Luty 2018 13:07

Cze wszystkim

Dużo koduję na VBA excelu i chciałbym go używać w SW.

Chciałbym wyodrębnić niestandardowe dane części w dokumencie programu Excel.

Więc jeśli ktoś może mi pomóc, po prostu spraw, żebym wyglądał na spersonalizowaną właściwość pokoju w msgbox po tym, jak przygotuję się na resztę.

Z góry dziękuję

d_roger · 2 Luty 2018 13:45

Witam

Zobacz kod poniżej:

Option Explicit

Sub main()

Dim swApp                   As SldWorks.SldWorks
Dim swModel                 As SldWorks.ModelDoc2
Dim swModelDocExt           As SldWorks.ModelDocExtension

Dim val                     As String
Dim valout                  As String
Dim bool                    As Boolean

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension

Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim nNbrProps As Long
Dim vPropNames As Variant
Dim K As Long

Set cusPropMgr = swModelDocExt.CustomPropertyManager("")

nNbrProps = cusPropMgr.Count
vPropNames = cusPropMgr.GetNames
For K = 0 To nNbrProps - 1
    bool = cusPropMgr.Get4(vPropNames(K), False, val, valout)
    MsgBox vPropNames(K) & " - " & val & " - " & valout
Next K

End Sub

Pozdrowienia

Cyril_f · 2 Luty 2018 13:46

Witam

Temat już kilkakrotnie poruszany, ale: http://help.solidworks.com/2016/english/api/sldworksapi/Get_Custom_Properties_of_Referenced_Part_Example_VB.htm

d_roger · 2 Luty 2018 14:30

Powyższe przykłady umożliwiają pobranie niestandardowych właściwości karty "Dostosuj", jeśli chcesz również pobrać te z zakładki "Specyficzne dla konfiguracji" dla każdej konfiguracji, możesz zobaczyć przykład pod następującym linkiem: http://help.solidworks.com/2013/English/api/sldworksapi/Get_Custom_Properties_Example_VB.htm

Pozdrowienia

js_1207 · 5 Luty 2018 11:07

Witam wszystkich i dziękuję za odpowiedź. Mój nie jest tak dobry, ponieważ jestem w tej chwili bardzo zajęty ...

Zauważyłem różne posty, ale kiedy w moim pokoju mam niestandardową właściwość "Wykończenie" i chcę msgbox "RAL9010", gdy uruchamiam makro, nie mogę tego zrobić...

Cyril_f · 5 Luty 2018 11:48

Witam

Gdybyś mógł opublikować swoje makro, byłoby łatwiej.

d_roger · 5 Luty 2018 12:06

Witam

Jeśli chcesz sterować Solidworks z Excela, musiszpomyśleć o zadeklarowaniu SolidWorks w Excelu za pomocą "CreateObject" i umieszczeniu niezbędnych odniesień w swoim makrze. Makro w pierwszym poście działa i wyświetla pole msgbox zawierające "Nazwa właściwości - Wyrażenie tekstowe - Obliczona wartość" dla każdej właściwości na karcie dostosowywania.

Pozdrowienia

d_roger · 5 Luty 2018 12:17

Więc:

i:

Sub Macro1()
    
Dim swApp                   As SldWorks.SldWorks
Dim swModel                 As SldWorks.ModelDoc2
Dim swModelDocExt           As SldWorks.ModelDocExtension

Dim val                     As String
Dim valout                  As String
Dim bool                    As Boolean

Set swApp = CreateObject("SldWorks.Application")
swApp.Visible = True
        
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension

Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim nNbrProps As Long
Dim vPropNames As Variant
Dim K As Long

Set cusPropMgr = swModelDocExt.CustomPropertyManager("")

nNbrProps = cusPropMgr.Count
vPropNames = cusPropMgr.GetNames
For K = 0 To nNbrProps - 1
    bool = cusPropMgr.Get4(vPropNames(K), False, val, valout)
    MsgBox vPropNames(K) & " - " & val & " - " & valout
Next K

End Sub

Daje:

Pozdrowienia

js_1207 · 5 Luty 2018 13:32

W rzeczywistości działa to bardzo dobrze, po prostu pomyliłem właściwość niestandardową i specyficzną dla konfiguracji lzq... co za kluski pffff

Czy można zrobić to samo ze specyfikami?

Dziękuję Wam wszystkim!

d_roger · 5 Luty 2018 13:48

Witam

Tak, jest to zaznaczone powyżej:

Powyższe przykłady umożliwiają pobranie niestandardowych właściwości karty "Dostosuj", jeśli chcesz również pobrać te z zakładki "Specyficzne dla konfiguracji" dla każdej konfiguracji, możesz zobaczyć przykład pod następującym linkiem: http://help.solidworks.com/2013/English/api/sldworksapi/Get_Custom_Properties_Example_VB.htm

Pozdrowienia

js_1207 · 5 Luty 2018 13:52

Na szczycie!!

Ostatnie pytanie: szukam odzyskania oszacowanej wartości, a nie wartości.

nNumProp = swConfig.GetCustomProperties(vPropName, vPropValue, vPropType)

Z góry dziękuję

Cyril_f · 5 Luty 2018 15:39

Witam

Ze swojej strony używam zamiast tego tego:

Set swCustProp = swConfig.CustomPropertyManager
boolstatus = swCustProp.Get5("xxx", False, ValOut, ResolvedValOut, WasResolved) 'Changer "xxx" par le nom de la propriété du fichier 3D

Valout = wartość wyrażenia

ResolvedValout = Obliczona wartość

d_roger · 5 Luty 2018 16:20

Zgadzam się z Cyril.f, oto przykład do odczytania wartości "nazwa właściwości - Wyrażenie tekstowe - Wartość oceniona" dla każdej właściwości aktywnej konfiguracji:

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim config As SldWorks.Configuration
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim lRetVal As Long
Dim vPropNames As Variant
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Dim nNbrProps As Long
Dim j As Long

Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set config = swModel.GetActiveConfiguration
    Set cusPropMgr = config.CustomPropertyManager

    nNbrProps = cusPropMgr.Count
    vPropNames = cusPropMgr.GetNames

    For j = 0 To nNbrProps - 1
        lRetVal = cusPropMgr.Get5(vPropNames(j), False, ValOut, ResolvedValOut, wasResolved)
        Debug.Print vPropNames(j) & ", " & ValOut & ", " & ResolvedValOut
    Next j

End Sub

Pozdrowienia

d_roger · 5 Luty 2018 16:32

Lub, jeśli znasz nazwę swojej konfiguracji, po prostu musisz zmienić linię:

Ustaw cusPropMgr = swModelDocExt.CustomPropertyManager("")

przez:

Ustaw cusPropMgr = swModelDocExt.CustomPropertyManager("xxxxxxx")

W makrze podanym w najlepszej odpowiedzi, xxxxxxx to nazwa konfiguracji.

Pozdrowienia

js_1207 · 6 Luty 2018 09:57

Doskonały!!! Skończyłem swój program i działa idealnie...

Teraz muszę poszukać, aby pobrać niestandardowe właściwości każdej części zespołu...

Jeszcze raz dziękuję całemu zespołowi.

system · 8 Marzec 2018 07:30

Cześć wszystkim

Miałem kod, który stworzyłem w SW2014, który również działał wspaniale, ale to już nie działa w SW2016.

Oto kod, o którym mowa:

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModelDoc As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swPackAndGo As SldWorks.PackAndGo
Dim openFile As String
Dim myFileName As String
Dim pgFileNames As Variant
Dim pgFileStatus As Variant
Dim pgSetFileNames() As String
Dim pgGetFileNames As Variant
Dim pgDocumentStatus As Variant
Dim status As Boolean
Dim warnings As Long
Dim errors As Long
Dim i As Long
Dim j As Long
Dim namesCount As Long
Dim myPath As String
Dim statuses As Variant

Public Chemin, OldFile As String
Public Ligne1, DernligneASM

Sub ListerOldFichiers()

Dim Fichier As String

Range("A2:B1000") = "" 'Vidage des cellules

Chemin = CheminUser
OldFile = Dir(Chemin & "*.sldasm")

'Appel de la progressbar

UserForm1.Show vbModeless
UserForm1.ProgressBar1.Value = 0

Dim ProgressBar, barre

UserForm1.ProgressBar1.Value = 10

'Ecrire les noms de fichiers dans colone A

Ligne1 = 2 'Départ pour rentrer les noms de fichiers

    Do While OldFile <> ""
    
        Cells(Ligne1, 1) = OldFile
        OldFile = Dir()
        Ligne1 = Ligne1 + 1
    
    Loop

DernligneASM = Range("a65536").End(xlUp).Row

Dim Dernligne2
Dernligne2 = Range("a65536").End(xlUp).Row + 1

OldFile = Dir(Chemin & "*.sldprt")

    Do While OldFile <> ""
    
        Cells(Dernligne2, 1) = OldFile
        OldFile = Dir()
        Dernligne2 = Dernligne2 + 1
        
    Loop

UserForm1.ProgressBar1.Value = 50


Dim Dernligne3
Dernligne3 = Range("a65536").End(xlUp).Row

Ligne1 = 2

For Ligne1 = Ligne1 To Dernligne3

        Dim DSO As DSOFile.OleDocumentProperties
        Dim File1, OldDes, k, PropName, Compteur

        File1 = Cells(Ligne1, 1).Value

        Set DSO = New DSOFile.OleDocumentProperties
        DSO.Open sfilename:=Chemin & File1

        Compteur = DSO.CustomProperties.Count

        If Compteur <> 0 Then

            For k = 1 To Compteur - 1

                PropName = DSO.CustomProperties.Item(k).Name

                If PropName = "Designation-1" Then

                    OldDes = DSO.CustomProperties.Item("Designation-1").Value
                    Cells(Ligne1, 2) = OldDes

                End If

            Next k

        End If

        DSO.Save
        DSO.Close

Next

'Fini de remplir et Decharger l'userform

barre = 100
UserForm1.ProgressBar1.Value = barre
Unload UserForm1
ProgressBar = 0 'Réinitialisation

MsgBox "Remplissez la colonne des Nouveaux noms a attribuer puis cliquez sur ''Renommer''"

End Sub

W ramach projektu "DSO. CustomProperties.Count" już nie działa... z tego co mogłem zobaczyć, to byłaby to część DSO, która nie jest już brana pod uwagę. Ale nie wiem czym go zastąpić...

Dziękuję za pomoc

d_roger · 8 Marzec 2018 22:03

Witam

Lepiej byłoby stworzyć nowe pytanie niż kolejkować pytanie, które zostało już rozwiązane, łatwiej jest znaleźć odpowiedzi na dane problemy.

W przypadku problemu z DSO, który już nie działa, myślę, że będziesz musiał ponownie napisać makro, zobacz https://forum.solidworks.com/thread/88676.

Pozdrowienia

system · 9 Marzec 2018 09:14

O przepraszam... Czy możemy przenieść tę wymianę na nowy temat?

Dziękuję za odpowiedź. Jaka jest metoda stosowana od 2015 roku?

gt22 · 9 Marzec 2018 09:19

Otwórz kolejne pytanie dziękuję

@+

system · 9 Marzec 2018 09:43

Masz to: http://www.lynkoa.com/forum/solidworks/r%C3%A9cupererecrire-propri%C3%A9t%C3%A9s-personalis%C3%A9s-avec-excel-sans-methode-dso-inactive-depuis