API: Pobieranie właściwości elementu użytkownika z rysunku

2D plans Layout
1

Witam

Chcę ustawić moją zmienną "TypePiece" na wartość właściwości "Type" (jeśli istnieje).

Znalazłem już kilka tematów na forum lub gdzie indziej, ale żaden z nich nie przyniósł owoców...

Moje makro uruchamia się po wybraniu widoku pomieszczenia.

Celem jest możliwość oddzielenia części z właściwością type=PROFILE i części bez właściwości type, aby móc utworzyć dostosowaną adnotację automatyczną.

Pozdrowienia

Function Attache_PrivateAnnotation(swModel As SldWorks.ModelDoc2, selView As SldWorks.View, Position As Variant)
    Dim Note As Object
    Dim Annotation As Object
    Dim TextFormat As Object
    Dim Namev As String
    Dim strAnnot As String
    Dim TypePiece As String
     
     Set SWmoddoc = swApp.ActiveDoc
     TypePiece = SWmoddoc.GetCustomInfoValue("", "Type")
     MsgBox (TypePiece)
     
     
     
    'Namev = selView.GetName2()  ' on recupere le nom de la vue
    'la synthaxe pour obtenir une propriété est $PRP:"NomPropriete"
    ' on rentre les annotations ligne par ligne avec possibilité de faire des tests sur chaque pour avoir comme resultat l'annotation complete en variable
    ''strAnnot = "Rep: " + "$PRP:""" + Namev + "_NUM""" + vbNewLine
    'strAnnot = strAnnot + "Qt: " + "$PRP:""" + Namev + "_QT""" + vbNewLine
    'strAnnot = strAnnot + "Ep: $PRPSHEET:""Epaisseur"" "
    'If BOM_ReadPropertie(swModel, "", Namev + "Epaisseur") <> "" Then ' si la piece a une epaisseur
    'strAnnot = strAnnot + "Ep: " + "$PRP:""" + Namev + "Epaisseur""" + vbNewLine  'on ajoute l'epaisseur
    'End If
    Set Note = swModel.InsertNote(strAnnot) 'insertion de l'annotation
    If Not Note Is Nothing Then 'si elle est créée
       Note.Angle = 0 ' angle de zero
       boolstatus = Note.SetBalloon(0, 0) 'pas d'encadrement
       Set Annotation = Note.GetAnnotation() 'on recupere l'annotation pour la formater autrement
       If Not Annotation Is Nothing Then 'si elle est créée
          longstatus = Annotation.SetLeader2(False, 0, True, False, False, False)   'format de l'annotation (pas de fleche...)
          boolstatus = Annotation.SetPosition(Position(0), Position(1), Position(2))    'on récupere les coordonnées du variant Position
          boolstatus = Annotation.SetTextFormat(0, True, TextFormat)    'Format du text
       End If
    End If
End Function

 

2

Witam

Właściwość to dane z 3D, więc musisz uzyskać właściwości tego pliku, pobierając nazwę pliku dołączonego do widoku, otwórz go, a następnie odczytaj właściwość.

Zasadniczo musisz przejść przez swView.GetReferencedModelName i swView.ReferencedConfiguration, jeśli istnieją pliki konfiguracyjne.

Następnie aktywuj model (ponieważ jest już otwarty w tle) i przetwórz odzyskiwanie właściwości.

 

1 polubienie
3

Dziękuję za odpowiedź,

Aby zrozumieć ten proces, stworzyłem małe makro, które ma na celu podanie mi typu części w MsgBox. Korzystając z funkcji swView.GetReferencedModelName, pobieram nazwę i ścieżkę do pliku należącego do wybranego widoku na moim rysunku. Ale nadal nie mogę znaleźć swojej nieruchomości.

Sub main()

Dim swApp       As SldWorks.SldWorks
Dim swModel     As SldWorks.ModelDoc2
Dim swDraw      As SldWorks.DrawingDoc
Dim swSelMgr    As SldWorks.SelectionMgr
Dim swView      As SldWorks.View

Dim Fichier   As String
Dim Type_Piece  As String


Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swSelMgr = swModel.SelectionManager
Set swView = swSelMgr.GetSelectedObject6(1, -1)

Fichier = swView.GetReferencedModelName
MsgBox (Fichier)

Type_Piece = Fichier.GetCustomInfoValue("", "Type")
MsgBox (Type_Piece)

End Sub

 

4

Witam

Musimy dodać to z grubsza do następujących elementów:

Dim swCustProp                  As CustomPropertyManager
Dim swConfig                    As SldWorks.Configuration
Dim boolstatus                  As Boolean
Dim WasResolved                 As Boolean
Dim ValOut                      As String
Dim ResolvedValOut              As String


Set swModel = swApp.ActivateDoc3(Fichier, True, swOpenDocOptions_Silent, nErrors)
Set swModel = swApp.ActiveDoc
Set swConfig = swModel.GetActiveConfiguration
Set swCustProp = swConfig.CustomPropertyManager
boolstatus = swCustProp.Get5("Type", False, ValOut, ResolvedValOut, WasResolved)
Debug.print ResolvedValOut

 

Aby przełączyć się z powrotem do planu na końcu i kontynuować przetwarzanie, musisz dodać dwa poniższe wiersze w końcowym kodzie.

swApp.CloseDoc (Fichier)
Set swModel = swApp.ActiveDoc

 

5

Rozumiem logikę twojego kodu, ale makro się nie uruchamia, VBA nie lubi "nErrors". Informuje mnie o błędzie kompilacji "Niezgodny typ argumentu ByRef". Tak jakby moja zmienna swModel nie była oczekiwanego typu.

6

Din nErrors tak długo

7

Ale tak, jestem głupi.

Teraz makro się uruchamia, ale w moim MsgBox, gdzie mam wyświetlić właściwość "Type", nie mam nic...

8

Należy wywołać zmienną ResolvedValOut lub zapisać ją w innej zmiennej typu string

9

Tak, napisałem tak:

boolstatus = swCustProp.Get5("Type", False, ValOut, ResolvedValOut, WasResolved)
swApp.CloseDoc (Fichier)

MsgBox (ResolvedValOut)

 

10

Czy używany plik zawiera wartość obok właściwości Type, czy nie? Testowałem z poniższym kodem z inną właściwością naszych plików i nie napotkałem żadnych problemów.

Sub main()

Dim swApp       As SldWorks.SldWorks
Dim swModel     As SldWorks.ModelDoc2
Dim swDraw      As SldWorks.DrawingDoc
Dim swSelMgr    As SldWorks.SelectionMgr
Dim swView      As SldWorks.View
Dim swCustProp                  As CustomPropertyManager
Dim swConfig                    As SldWorks.Configuration
Dim boolstatus                  As Boolean
Dim WasResolved                 As Boolean
Dim ValOut                      As String
Dim ResolvedValOut              As String
Dim nErrors As Long
Dim Fichier   As String
Dim Type_Piece  As String

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swSelMgr = swModel.SelectionManager
Set swView = swSelMgr.GetSelectedObject6(1, -1)

Fichier = swView.GetReferencedModelName

Set swModel = swApp.ActivateDoc3(Fichier, True, swOpenDocOptions_Silent, nErrors)
Set swModel = swApp.ActiveDoc
Set swConfig = swModel.GetActiveConfiguration
Set swCustProp = swConfig.CustomPropertyManager
boolstatus = swCustProp.Get5("Reference", False, ValOut, ResolvedValOut, WasResolved)
swApp.CloseDoc (Fichier)

MsgBox (ResolvedValOut)

End Sub

 

11

Tak samo, mój MsgBox jest pusty.

Mam jednak właściwość "Type" w moim pokoju.

 


capture_20180302png.png
12

Zamiast tego wypróbuj ten kod:

Sub main()

Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
Dim swDraw          As SldWorks.DrawingDoc
Dim swSelMgr        As SldWorks.SelectionMgr
Dim swView          As SldWorks.View
Dim swCustProp      As CustomPropertyManager
Dim swModelDocExt   As ModelDocExtension
Dim boolstatus      As Boolean
Dim WasResolved     As Boolean
Dim ValOut          As String
Dim ResolvedValOut  As String
Dim nErrors         As Long
Dim Fichier         As String
Dim Type_Piece      As String

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swSelMgr = swModel.SelectionManager
Set swView = swSelMgr.GetSelectedObject6(1, -1)

Fichier = swView.GetReferencedModelName

Set swModel = swApp.ActivateDoc3(Fichier, True, swOpenDocOptions_Silent, nErrors)
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")

boolstatus = swCustProp.Get5("Type", False, ValOut, ResolvedValOut, WasResolved)
swApp.CloseDoc (Fichier)

MsgBox (ResolvedValOut)


End Sub

Kod zaoferowany wcześniej pobierał informacje z zakładki specyficznej dla konfiguracji. Ten kod spowoduje wyszukanie "Dostosuj".

13

Nikiel!

Dziękuję.