Witam
Pracuję nad interfejsem API solidwork i próbuję uzyskać dostęp do informacji w części. Pracuję na elementach na długość, składających się z wytłaczania, a czasem usuwania materiału.
Udało mi się odzyskać wymiary wyciągnięcia za pomocą mojego kodu, jednak są obecne liście szkicu i chciałbym mieć możliwość ich wykluczenia.
Spróbowałem więc znaleźć odpowiedni szkic dla wyciągnięcia, aby móc odczytać dane. Udało mi się znaleźć nazwę szkicu, ale nie mogłem uzyskać dostępu do danych. Regularnie otrzymuję komunikat o błędzie " Właściwość lub metoda nie jest obsługiwana przez ten obiekt ". Chyba czegoś mi brakuje w manipulacji przedmiotami.
Widziałem SketchManagera, ale nie rozumiem, jak z niego korzystać.
Oto mój kod:
Sub GetExtrusionDimensions()
' Initialize SolidWorks application and get the active document
Dim swApp As SldWorks.SldWorks
Dim Part As ModelDoc2
Dim Feature As Feature
Dim ExtrudeFeat As ExtrudeFeatureData
Dim DisplayDim As DisplayDimension
Dim DimVal As Dimension
Dim MsgStr As String
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
' Check if the active document is a part file
If Part Is Nothing Or Part.GetType <> swDocPART Then
MsgBox "Veuillez ouvrir une pièce avant d'exécuter ce script.", vbCritical
Exit Sub
End If
' Start with the first feature in the part
Set Feature = Part.FirstFeature
MsgStr = "Dimensions des extrusions :" & vbNewLine & vbNewLine
' Loop through each feature in the feature tree
Do While Not Feature Is Nothing
' Check if the feature is an extrusion
If Feature.GetTypeName2 = "Extrusion" Then
' Access extrusion-specific data
Set ExtrudeFeat = Feature.GetDefinition
If Not ExtrudeFeat Is Nothing Then
MsgStr = MsgStr & "Fonction : " & Feature.Name & vbNewLine
' Access display dimensions
Set DisplayDim = Feature.GetFirstDisplayDimension
Do While Not DisplayDim Is Nothing
' Get the linked dimension object
Set DimVal = DisplayDim.GetDimension
If Not DimVal Is Nothing Then
MsgStr = MsgStr & " Dimension : " & DimVal.FullName & " = " & DimVal.Value & " mm" & vbNewLine
End If
' Move to the next display dimension
Set DisplayDim = Feature.GetNextDisplayDimension(DisplayDim)
Loop
MsgStr = MsgStr & vbNewLine
End If
End If
' Move to the next feature in the tree
Set Feature = Feature.GetNextFeature
Loop
' Display the extracted information
MsgBox MsgStr, vbInformation, "Résultats"
Koniec subwoofera
I mój kod do znajdowania relacji nadrzędnych funkcji:
Sub ListFeatureParents()
Dim swApp jako SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swFeature jako SldWorks.Feature
Dim swParentFeature jako SldWorks.Feature
Dim vParents jako wariant
Dim i As Liczba całkowita
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "Aucun document actif. Veuillez ouvrir une pièce.", vbExclamation
Exit Sub
End If
If swModel.GetType <> swDocPART Then
MsgBox "Ce script fonctionne uniquement avec des pièces.", vbExclamation
Exit Sub
End If
' Boucle à travers toutes les fonctions
Set swFeature = swModel.FirstFeature
Do While Not swFeature Is Nothing
' Afficher le nom et le type de la fonction
Debug.Print "Feature: " & swFeature.Name & " (" & swFeature.GetTypeName2 & ")"
' Récupérer les parents de la fonction
vParents = swFeature.GetParents
If Not IsEmpty(vParents) Then
For i = LBound(vParents) To UBound(vParents)
Set swParentFeature = vParents(i)
If Not swParentFeature.Name = "face" Or swParentFeature.Name = "Origine" Then
Debug.Print " -> Parent Feature: " & swParentFeature.Name & " (" & swParentFeature.GetTypeName2 & ")"
End If
Next i
Else
Debug.Print " -> No Parent Features"
End If
' Passer à la fonction suivante
Set swFeature = swFeature.GetNextFeature
Loop
Koniec subwoofera