Hallo
Ik wil graag gevolg geven aan een verzoek uit onze mappen om een van onze macro's aan te passen om het knip + vouwplan te maken, via Vba een annotatie toe te voegen die de vaste zijde van een ongevouwen MEP aangeeft.
De handmatige methode om dit gezicht te kantelen:
Uit een kamer lukt het me om dit gezicht terug te halen in een selectie met deze code:
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim selManager As SldWorks.SelectionMgr
Dim swFeat As SldWorks.Feature
Dim swFlatPatt As SldWorks.FlatPatternFeatureData
Dim lErrors As Long
Dim lWarnings As Long
Dim bRet As Boolean
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set selManager = swModel.SelectionManager
'********************************************************************************
'A modifier pour sélectionner depuis une MEP au lieu de depuis la pièce
'********************************************************************************
If (swModel.GetType <> swDocPART) Then
MsgBox "Merci d'ouvrir une pièce de tôlerie avant de relancer!"
Exit Sub
End If
'On lance la fonction pour afficher la face fixe (= côté protection PVC)
get_fixed_face
Dim swFace1 As Face2
Dim reponse As Integer
reponse = MsgBox("Voulez vous sélectionner une autre face protégée (film PVC) pour la pièce de tôlerie?" + Chr(10) + "Si oui merci de sélectionner une nouvelle face une fois cette fenêtre fermé.", vbQuestion + vbYesNo + vbDefaultButton1, "Selection de la face protéger (PVC)")
If reponse = vbNo Then
'On descend la barre
swFlatPatt.ReleaseSelectionAccess
Exit Sub
Else
'On descend la barre
swFlatPatt.ReleaseSelectionAccess
End If
Do While swFace1 Is Nothing
Set swFace1 = selManager.GetSelectedObject6(1, -1)
DoEvents
Loop
'On lance les 2 fonctions imbriquées
set_fixed_face get_flat_feature(swFace1.GetBody), swFace1
'On sauvegarde les changements
bRet = swModel.Save3(swSaveAsOptions_Silent, lErrors, lWarnings)
End Sub
Public Function get_flat_feature(bod As Body2) As Feature
Dim featurmgr As FeatureManager
Set featurmgr = swModel.FeatureManager
Dim flatpaternfolder As FlatPatternFolder
Set flatpaternfolder = featurmgr.GetFlatPatternFolder()
Dim flatfeatures As Variant
flatfeatures = flatpaternfolder.GetFlatPatterns()
Dim sFlatPatternFeatureData As FlatPatternFeatureData
Dim face As Face2
Dim feat As Variant
For Each feat In flatfeatures
Set sFlatPatternFeatureData = feat.GetDefinition()
Set face = sFlatPatternFeatureData.FixedFace2
If face.GetBody.Name = bod.Name Then
Set get_flat_feature = feat
Exit Function
End If
Next
End Function
Public Sub set_fixed_face(feat As Feature, face As Face2)
Dim sFlatPatternFeatureData As FlatPatternFeatureData
Set sFlatPatternFeatureData = feat.GetDefinition()
sFlatPatternFeatureData.AccessSelections swModel, Nothing
sFlatPatternFeatureData.FixedFace2 = face
feat.ModifyDefinition sFlatPatternFeatureData, swModel, Nothing
End Sub
Public Function get_fixed_face()
Set swFeat = swModel.FirstFeature 'Va au 1er feature dans la pièce.
'Tourne jusqu'à trouver un feature 'FlatPattern'.
Do Until swFeat Is Nothing
'On vérifie si le feature est 'FlatPattern' ou pas.
Debug.Print "Type name:" & swFeat.GetTypeName
Debug.Print "Name:" & swFeat.Name
If swFeat.GetTypeName = "FlatPattern" Then
Dim swFixedFace As SldWorks.Face2
Dim selectData As SldWorks.selectData
Set swFlatPatt = swFeat.GetDefinition
bRet = swFlatPatt.AccessSelections(swModel, Nothing)
Set swFixedFace = swFlatPatt.FixedFace2
bRet = swFixedFace.Select4(True, selectData)
'********************************************************************************
'Depuis cette sélection ajout d'une annotation sur la face sélectionné avec texte face fixe
'********************************************************************************
Exit Function
Else
End If
Set swFeat = swFeat.GetNextFeature 'Va au feature suivant.
Loop
End Function
Heb je enig idee hoe je:
1-Start de macro vanuit een MEP in plaats van vanuit de kamer
2-Voeg de annotatie toe aan de geselecteerde kant (vaste kant)
Punt 1 lijkt mij haalbaar, punt 2 zie ik niet echt welke functie ik moet gebruiken en enkele ideeën zouden welkom zijn!
Bij voorbaat dank
