Ich möchte meine Variable "TypePiece" auf den Wert der Eigenschaft "Type" setzen (falls vorhanden).
Ich habe bereits ein paar Themen im Forum oder anderswo gefunden, aber keines davon hat Früchte getragen...
Mein Makro startet, wenn die Raumansicht ausgewählt ist.
Ziel ist es, Teile mit der Eigenschaft type=PROFILE und Teile ohne die Eigenschaft type trennen zu können, um eine angepasste automatische Beschriftung erstellen zu können.
Herzliche Grüße
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
Bei der Eigenschaft handelt es sich um Daten aus 3D, daher müssen Sie die Eigenschaften dieser Datei abrufen, indem Sie den Namen der Datei abrufen, die an die Ansicht angehängt ist, sie öffnen und dann die Eigenschaft lesen.
Grundsätzlich müssen Sie swView.GetReferencedModelName und swView.ReferencedConfiguration durchgehen, wenn Konfigurationsdateien vorhanden sind.
Aktivieren Sie dann das Modell (da es bereits im Hintergrund geöffnet ist) und führen Sie die Wiederherstellung der Eigenschaft durch.
Um den Prozess zu verstehen, habe ich ein kleines Makro erstellt, das mir den Typ des Teils in einer MsgBox geben soll. Mit der swView.GetReferencedModelName-Funktion rufe ich den Namen und den Pfad der Datei ab, die zur ausgewählten Ansicht in der Zeichnung gehört. Aber ich kann meine Immobilie immer noch nicht finden.
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
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
Um am Ende wieder zum Plan zu wechseln und die Verarbeitung fortzusetzen, müssen Sie die beiden folgenden Zeilen im endgültigen Code hinzufügen.
swApp.CloseDoc (Fichier)
Set swModel = swApp.ActiveDoc
Ich verstehe die Logik Ihres Codes, aber das Makro wird nicht gestartet, VBA mag die "nErrors" nicht. Es wird mir ein Kompilierungsfehler "Inkompatibler ByRef-Argumenttyp" angezeigt. Als ob meine swModel-Variable nicht vom erwarteten Typ wäre.
Enthält die von Ihnen verwendete Datei einen Wert neben der Type-Eigenschaft oder nicht? Ich habe mit dem folgenden Code mit einer anderen Eigenschaft unserer Dateien und ohne Probleme getestet.
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
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
Der zuvor angebotene Code hat die Informationen von der konfigurationsspezifischen Registerkarte abgerufen. Dieser Code sucht nach "Anpassen".