Bonjour
J'ai essayer pas mal de bidouille pour y parvenir mais rien y fais
Je veux supprimer les cotes bancales, sur une mise en plans, automatiquement via une macro. J'ai donc utilisé l'enregistrement de macro pour cela, mais cette dernière après enregistrement ne fonctionne pas quand je la rejoue. Elle ce lance mais ne change rien...
Auriez vous une solution?
Ps: Je veux absolument le gérer en VBA via Excel et je suis novice.
Merci
Les côtes d'une pièce ou celles d'un dessin?
Pour une pièce:
Option Explicit
Dim swModel As SldWorks.ModelDoc2
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swFeat As SldWorks.Feature
Dim swSubFeat As SldWorks.Feature
Dim swDispDim As SldWorks.DisplayDimension
Dim swAnn As SldWorks.Annotation
Dim boolstatus As Boolean
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swFeat = swModel.FirstFeature
Do While Not swFeat Is Nothing
'Debug.Print " " + swFeat.Name
Set swSubFeat = swFeat.GetFirstSubFeature
Do While Not swSubFeat Is Nothing
' Debug.Print " " + swSubFeat.Name
DeleteFeatureDim swSubFeat
Set swSubFeat = swSubFeat.GetNextSubFeature
Loop
DeleteFeatureDim swFeat
Set swFeat = swFeat.GetNextFeature
Loop
End Sub
Sub DeleteFeatureDim(ByVal swFeat As SldWorks.Feature)
Dim swDispDim As SldWorks.DisplayDimension
Dim swAnn As SldWorks.Annotation
Dim boolstatus As Boolean
Set swDispDim = swFeat.GetFirstDisplayDimension
Do While Not swDispDim Is Nothing
Set swAnn = swDispDim.GetAnnotation
'Debug.Print " [" & swDim.FullName & "] = " & swDim.GetSystemValue2("")
If swAnn.IsDangling Then
boolstatus = swFeat.Select2(False, 0)
swModel.EditSketch
boolstatus = swAnn.Select3(False, Nothing)
boolstatus = swModel.Extension.DeleteSelection2(0)
swModel.InsertSketch2 True
End If
Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
Loop
End Sub
Pour un dessin:
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swDraw As DrawingDoc
Dim swSheet As Sheet
Dim swView As View
Dim boolstatus As Boolean
Dim swAnn As Annotation
Dim swDispDim As DisplayDimension
Dim vSheetNames As Variant
Dim i As Integer
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel.GetType <> SwConst.swDocumentTypes_e.swDocDRAWING Then Exit Sub
Set swDraw = swModel
swModel.ClearSelection2 (True)
vSheetNames = swDraw.GetSheetNames
For i = 0 To UBound(vSheetNames)
swDraw.ActivateSheet vSheetNames(i)
Set swSheet = swDraw.Sheet(vSheetNames(i))
Set swView = swDraw.GetFirstView
Do While Not swView Is Nothing
Set swAnn = swView.GetFirstAnnotation3
Do While Not swAnn Is Nothing
If swAnn.IsDangling Then
boolstatus = swAnn.Select3(True, Nothing)
End If
Set swAnn = swAnn.GetNext3
Loop
Set swView = swView.GetNextView
Loop
boolstatus = swModel.DeleteSelection(True)
swModel.ClearSelection2 (True)
Next
swModel.ClearSelection2 (True)
End Sub
Merci pour ta solution mais malheureusement, je ne parvient pas à la faire fonctionner. Le problème ne viens sûrement pas de ta solution mais plus de mes compétences.
Je pilote tout mon projet par macro Excel avec les outils références de SolidWorks activé. J'intègre aussi tout les "Dim" et autre chose dans la méthode car je ne maîtrise pas encore toute les subtilités. Et je regarde ta méthode mais je ne parviens pas à comprendre quel sont les paramètres à modifiés.
Quelle macro tu utilise? pièce ou dessin?
Les macros fonctionnent en tant que macro SolidWorks (enregistrée dans un fichier swp). Dans un premier temps, est ce que tu peux essayer de voir si ca marche comme ca?
Après le problème ne peut venir que de la facon dont c'est intégré dans le fichier Excel. Est ce que tu peux joindre le fichier?
J'utilise la macro dessins
j'ai essayer de contourner mon problème en marquant les cote a importé de la 3d au 2d, mais je fais aussi choux blanc...
Malheureusement le pour l'entreprise cela est un fichier sensible, je ne peu donc te passé que quelques bribes.J'ai donc été contrains de supprimer un grande parti des données, je ne pratique pas encore la programmation orienté objet mais cela sera ma prochaine étape.
Je viens de testé en copiant bêtement ta macro dans un nouveau fichier de macro Solidworks cette dernière s'exécute mais il n'y as aucun résultats. j'ai pris celle pour les mise en plans. Je ne comprend vraiment pas ce que je fait de travers...
Si tu peux pas joindre ta pièce, tu peux crée un cube avec un dessin et une dimension bancale telle que c'est fait sur ta pièce. Vérifie que la macro ne marche pas sur ce dessin, puis joins le sldprt, slddrw et swp.
Sinon tu peux essaye ca (adapté de https://www.eng-tips.com/faqs.cfm?fid=153 )
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.DrawingDoc
Dim dwgView As SldWorks.View
Dim dispDimension As SldWorks.DisplayDimension
Dim dwgDimension As SldWorks.Dimension
Dim dwgNote As SldWorks.Note
Dim dwgWeld As SldWorks.WeldSymbol
Dim dwgAnnotation As SldWorks.Annotation
Dim attachedEntitiesArray As Variant
Dim attachedEntityTypes As Variant
Dim bRemoveLastFlag As Boolean
Dim s1 As String
Dim sViewName As String, sDwgName As String
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set dwgView = Part.GetFirstView
Do While Not dwgView Is Nothing
'Travserse Through the Dimensions
Set dwgView = dwgView.GetNextView
If Not dwgView Is Nothing Then
sViewName = dwgView.Name
'Travserse through all of the dimensions in this view
Set dispDimension = dwgView.GetFirstDisplayDimension3
Do While Not dispDimension Is Nothing
Set dwgDimension = dispDimension.GetDimension
bRemoveLastFlag = False
If dwgDimension.Value = 0 Then
'Delete the Dimension
If InStr(1, dwgDimension.FullName, "Annotations") Then
'The next dimension must be selected before this one can be removed
bRemoveLastFlag = True
s1 = dwgDimension.Name & "@" & sViewName
End If
End If
Set dispDimension = dispDimension.GetNext3
If bRemoveLastFlag = True Then
Part.SelectByID s1, "DIMENSION", 0, 0, 0
Part.DeleteSelection False
bRemoveLastFlag = False
End If
Loop
'Travserse through all of the reference dimensions in this view
Set dispDimension = dwgView.GetFirstDisplayDimension3
Do While Not dispDimension Is Nothing
Set dwgAnnotation = dispDimension.GetAnnotation
'Only allow this to act on Reference Dimensions
If dwgAnnotation.GetName Like "RD*" Then
attachedEntitiesArray = dwgAnnotation.GetAttachedEntities
attachedEntityTypes = dwgAnnotation.GetAttachedEntityTypes
If IsEmpty(attachedEntitiesArray) Or IsNull(attachedEntitiesArray) Then
'Delete the Ref Dim
bRemoveLastFlag = True
s1 = dwgAnnotation.GetName & "@" & dwgView.Name
ElseIf attachedEntityTypes(0) = 0 Or attachedEntitiesArray(0) Is Nothing Then
'Delete the Ref Dim
bRemoveLastFlag = True
s1 = dwgAnnotation.GetName & "@" & dwgView.Name
ElseIf (UBound(attachedEntitiesArray) + 1) >= 2 Then
If attachedEntityTypes(1) = 0 Or attachedEntitiesArray(1) Is Nothing Then
'Delete the Ref Dim
bRemoveLastFlag = True
s1 = dwgAnnotation.GetName & "@" & dwgView.Name
End If
Else
'Attached
End If
End If
Set dispDimension = dispDimension.GetNext3
If bRemoveLastFlag = True Then
Part.SelectByID s1, "DIMENSION", 0, 0, 0
Part.DeleteSelection False
bRemoveLastFlag = False
End If
Loop
End If
Loop
MsgBox "Done!"
End Sub
Je viens de tester ce que tu m'as donné.J'ai bien le "Done" qui s'affiche à la fin, mais j'ai toujours ma cote bancal sur le plan. J'ai suivit ton conseille de faire une pièce simple pour les testes. Je te la joins.
Et voici la situation que j'essais de résoudre.
Je cote au préalable tout mes perçages mais certains peuvent devenir désactivé. De ce fait les cote étant déjà présentes ne servent plus, elles sont donc superflues et bancal. Avec ma macro, je voudrai éliminé ces dernières.
J'ai essayé sur ta pièce avec SW2016 et la première macro fonctionne (pas la dernière par contre)
La voici au format swp
Merciiiiii sa marche nickel et j'ai même réussi a l'adapter pour Excel.