Ik wil mijn variabele "TypePiece" instellen op de waarde van de eigenschap "Type" (indien aanwezig).
Ik heb al een paar onderwerpen op het forum of elders gevonden, maar geen van hen heeft vruchten afgeworpen...
Mijn macro wordt gestart wanneer de kamerweergave is geselecteerd.
Het doel is om delen met de eigenschap type=PROFILE te kunnen loskoppelen van die zonder de eigenschap type om een aangepaste automatische annotatie te kunnen maken.
Vriendelijke groeten
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
De eigenschap is gegevens uit 3D, dus u moet de eigenschappen van dit bestand ophalen door de naam van het bestand aan de weergave toe te voegen, het te openen en vervolgens de eigenschap te lezen.
In principe moet u swView.GetReferencedModelName en swView.ReferencedConfiguration doorlopen als er configuratiebestanden zijn.
Activeer vervolgens het model (aangezien het al op de achtergrond is geopend) en verwerk het herstel van de eigendom.
Om het proces te begrijpen, heb ik een kleine macro gemaakt die tot doel heeft mij het type onderdeel in een MsgBox te geven. Met behulp van de functie swView.GetReferencedModelName haal ik de naam en het pad op van het bestand dat bij de geselecteerde weergave in mijn tekening hoort. Maar ik kan mijn woning nog steeds niet vinden.
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
Om aan het einde terug te schakelen naar het plan en door te gaan met de verwerking, moet u de twee onderstaande regels toevoegen aan de uiteindelijke code.
swApp.CloseDoc (Fichier)
Set swModel = swApp.ActiveDoc
Ik begrijp de logica van uw code, maar de macro start niet, VBA houdt niet van de "nErrors". Het vertelt me een compilatiefout "Incompatible ByRef argument type". Alsof mijn swModel variabele niet van het verwachte type is.
Bevat het bestand dat u gebruikt een waarde naast de eigenschap Type of niet? Ik heb getest met de onderstaande code met een andere eigenschap van onze bestanden en geen problemen.
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
De eerder aangeboden code haalde de informatie op van het configuratiespecifieke tabblad. Deze code zoekt naar "Aanpassen".