I'm looking to set my "TypePiece" variable to the value of the "Type" property (when it exists).
I have already found a few topics on the forum or elsewhere but none of them have borne fruit...
My macro starts when the room view is selected.
The goal is to be able to dissociate parts with the type=PROFILE property and the one without the type property to be able to create an adapted automatic annotation.
Kind regards
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
The property is data from 3D, so you have to get the properties of this file by getting the name of the file attached to the view, open it and then read the property.
Basically, you have to go through swView.GetReferencedModelName and swView.ReferencedConfiguration if there are configuration files.
Then, activate the model (since it is already open in the background) and process the property recovery.
To understand the process, I made a small macro which aims to give me the Type of part in a MsgBox. Using the swView.GetReferencedModelName function, I retrieve the name and path of the file that belongs to the selected view in my drawing. But I still can't find my property.
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
To switch back to the plan at the end and continue the processing, you will have to add the two lines below in the final code.
swApp.CloseDoc (Fichier)
Set swModel = swApp.ActiveDoc
I understand the logic of your code, but the macro doesn't launch, VBA doesn't like the "nErrors". It tells me a compilation error "Incompatible ByRef argument type". As if my swModel variable is not of the expected type.
Does the file you use contain a value next to the Type property or not? I tested with the code below with another property of our files and no issues.
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
The code offered before fetched the information from the configuration-specific tab. This code will search for "Customize".