Forum SolidWorks A-S3D

par **rOhArT** » Mar 28 Fév 2012, 14:43

Bonjour,

J'ai réussi à extraire les repères de soudures mais j'aimerais savoir comment on fait pour avoir les repéres de soudures de la feuille active et du calque actif ?

voici mon code

Code: Tout sélectionner: Dim i = 0 Dim j = 0 Dim k = 0 swApp = GetObject(, "SldWorks.Application") If swApp Is Nothing Then MessageBox.Show("Veuillez ouvrir Solidworks avec le fichier qui contient les soudures") Exit Sub End If swModel = swApp.ActiveDoc swDwg = swModel swDwg.ClearSelection2(True) 'Set ExcelApp = CreateObject("Excel.Application") 'Set wbExcel = ExcelApp.Workbooks.Add() 'Set wsExcel = wbExcel.Worksheets(1) swLayerMgr = swModel.GetLayerManager vLayerArr = swLayerMgr.GetLayerList For Each vLayer In vLayerArr swLayer = swLayerMgr.GetLayer(vLayer) swView = swDwg.GetFirstView While Not swView Is Nothing swWeldSymbol = swView.GetFirstWeldSymbol While Not swWeldSymbol Is Nothing i = i + 1 For j = 0 To swWeldSymbol.GetTextCount 'MsgBox (swWeldSymbol.GetTextAtIndex(j)) If Microsoft.VisualBasic.Left(swWeldSymbol.GetTextAtIndex(j), 1) = "W" Or Microsoft.VisualBasic.Left(swWeldSymbol.GetTextAtIndex(j), 1) = "w" Then Tableau_Soudure(k) = swWeldSymbol.GetTextAtIndex(j) k = k + 1 End If Next j swWeldSymbol = swWeldSymbol.GetNext End While swView = swView.GetNextView End While Next Call Tri(Tableau_Soudure, True) 'enléve les doublons For j = 0 To 1000 If j - 1 >= 0 Then If Tableau_Soudure(j - 1) = Tableau_Soudure(j) Then Tableau_Soudure(j - 1) = "" End If End If Next Call Tri(Tableau_Soudure, True) Dim monStreamWriter As StreamWriter = New StreamWriter("C:\Temp\essai.txt") Dim fs = CreateObject("Scripting.FileSystemObject") 'Dim oFSO As Scripting.FileSystemObject 'Dim oFl As Scripting.File 'Dim oTxt As Scripting.TextStream 'on crée le fchier 'monFichierSoudure = "c:\Temp\FichierSoudure - " & Range("AD_Number").Value & ".txt" 'oTxt = fs.CreateTextFile(monFichierSoudure, True, False) 'Instanciation du FSO 'Set oFSO = New Scripting.FileSystemObject 'Set oFl = oFSO.GetFile(monFichierSoudure) 'Set oTxt = oFl.OpenAsTextStream(ForWriting) 'on remplit le fichier texte 'With oTxt For i = 0 To 1000 If Tableau_Soudure(i) <> "" Then monStreamWriter.WriteLine(Tableau_Soudure(i)) End If Next i 'End With 'fermeture du fichier texte 'oTxt.Close() monStreamWriter.Close()

merci d'avance

par **liryc** » Mar 28 Fév 2012, 19:36

Bonsoir,
C'est possible mais dans ce cas il faut changer le code au niveau de la boucle.
J'ai pas solid sous les yeux mais regarde dans l'aide de l'api à ActiveDrawingView et GetCurrentLayer.

par **rOhArT** » Mer 29 Fév 2012, 9:04

Merci pour l'intérêt que tu portes à mon problème

J'ai commencé à modifier mon code comme ceci :

Code: Tout sélectionner: swViewActive = swDwg.ActiveDrawingView swLayerMgr = swModel.GetLayerManager vLayerArr = swLayerMgr.GetLayerList swLayerActif = swLayerMgr.GetCurrentLayer() For Each vLayer In vLayerArr If vLayer.ToString = swLayerActif Then swWeldSymbol = swViewActive.GetFirstWeldSymbol While Not swWeldSymbol Is Nothing For j = 0 To swWeldSymbol.GetTextCount If Microsoft.VisualBasic.Left(swWeldSymbol.GetTextAtIndex(j), 1) = "W" Or Microsoft.VisualBasic.Left(swWeldSymbol.GetTextAtIndex(j), 1) = "w" Then Tableau_Soudure(k) = swWeldSymbol.GetTextAtIndex(j) k = k + 1 End If Next j End While End If Next

mais à la ligne If vLayer.ToString = swLayerActif Then

le programme n'entre jamais dans ma condition

de plus swViewActive est à nothing
et swLayerActif est égale ""

par **liryc** » Mer 29 Fév 2012, 9:50

Bonjour,
essaye comme ça:

Code: Tout sélectionner: swViewActive = swDwg.ActiveDrawingView swLayerMgr = swModel.GetLayerManager swLayerActif = swLayerMgr.GetCurrentLayer swWeldSymbol = swViewActive.GetFirstWeldSymbol While Not swWeldSymbol Is Nothing For j = 0 To swWeldSymbol.GetTextCount If Microsoft.VisualBasic.Left(swWeldSymbol.GetTextAtIndex(j), 1) = "W" Or Microsoft.VisualBasic.Left(swWeldSymbol.GetTextAtIndex(j), 1) = "w" Then Tableau_Soudure(k) = swWeldSymbol.GetTextAtIndex(j) k = k + 1 End If Next j End While

Je n'en suis pas sûr à 100% mais ça devrait fonctionner.
Sinon déjà supprime le () à swLayerMgr.GetCurrentLayer()

par **rOhArT** » Mer 29 Fév 2012, 10:03

non ça ne marche pas

à la ligne swWeldSymbol = swViewActive.GetFirstWeldSymbol

le programme s'arrête et me dit comme erreur

Object reference not set to an instance of an object.

car swViewActive est toujours à nothing

par **liryc** » Mer 29 Fév 2012, 22:17

Bonsoir,
Pas eu le temps de regarder dans la journée et n'ayant qu'une partie du code je ne vois pas où ça peut planter mais regarde déjà avec ce code s'il te retourne quelquechose ou pas.
Après regarde comment l'utiliser en partie dans ton code.

par **rOhArT** » Jeu 01 Mar 2012, 14:25

merci encore liryc

j'ai modifié le code complétement et je me suis apercu que cette partie du code me remenais toujours toutes les soudures même celle qui est cachée ???

Code: Tout sélectionner: swWeldSymbol = swView.GetFirstWeldSymbol While (Not swWeldSymbol Is Nothing) For j = 0 To swWeldSymbol.GetTextCount If (Microsoft.VisualBasic.Left(swWeldSymbol.GetTextAtIndex(j), 1) = "W" Or Microsoft.VisualBasic.Left(swWeldSymbol.GetTextAtIndex(j), 1) = "w") Then Tableau_Soudure(k) = swWeldSymbol.GetTextAtIndex(j) k = k + 1 End If Next j swWeldSymbol = swWeldSymbol.GetNext End While

voici mon code en entier

Code: Tout sélectionner: Dim i = 0 Dim j = 0 Dim k = 0 swApp = GetObject(, "SldWorks.Application") If swApp Is Nothing Then MessageBox.Show("Veuillez ouvrir Solidworks avec le fichier qui contient les soudures") Exit Sub End If swModel = swApp.ActiveDoc swDwg = swModel swDwg.ClearSelection2(True) swSheet = swDwg.GetCurrentSheet swDwg.ActivateSheet(swSheet.GetName) swDoc = swApp.ActiveDoc ' En fonction du type de document Select Case swDoc.GetType Case swconst.swDocumentTypes_e.swDocDRAWING swDraw = swDoc Call TraverseAnnotations(swDraw, True) Case Else swApp.SendMsgToUser2("Cette macro ne fonctionne que sur une mise en plan", swconst.swMessageBoxIcon_e.swMbWarning, swconst.swMessageBoxBtn_e.swMbOk) End End Select 'For Each vLayer In vLayerArr ' swLayer = swLayerMgr.GetLayer(vLayer) ' MessageBox.Show(swLayer.Name) ' If swLayer.Visible = True Then ' swView = swDwg.GetFirstView ' While Not swView Is Nothing ' swWeldSymbol = swView.GetFirstWeldSymbol ' While Not swWeldSymbol Is Nothing ' i = i + 1 ' For j = 0 To swWeldSymbol.GetTextCount ' 'MsgBox (swWeldSymbol.GetTextAtIndex(j)) ' If Microsoft.VisualBasic.Left(swWeldSymbol.GetTextAtIndex(j), 1) = "W" Or Microsoft.VisualBasic.Left(swWeldSymbol.GetTextAtIndex(j), 1) = "w" Then ' Tableau_Soudure(k) = swWeldSymbol.GetTextAtIndex(j) ' k = k + 1 ' End If ' Next j ' swWeldSymbol = swWeldSymbol.GetNext ' End While ' swView = swView.GetNextView ' End While ' End If 'Next Call Tri(Tableau_Soudure, True) 'enléve les doublons For j = 0 To 1000 If j - 1 >= 0 Then If Tableau_Soudure(j - 1) = Tableau_Soudure(j) Then Tableau_Soudure(j - 1) = "" End If End If Next Call Tri(Tableau_Soudure, True) Dim monStreamWriter As StreamWriter = New StreamWriter("C:\Temp\essai.txt") 'on remplit le fichier texte For i = 0 To 1000 If Tableau_Soudure(i) <> "" Then monStreamWriter.WriteLine(Tableau_Soudure(i)) End If Next i 'End With 'fermeture du fichier texte 'oTxt.Close() monStreamWriter.Close() End Sub Private Sub Tri(ByRef Liste() As String, ByVal bASC As Boolean) Dim i As Long, j As Long Dim temp2 As String If bASC Then ' croissant For i = LBound(Liste) To UBound(Liste) - 1 For j = i + 1 To UBound(Liste) If Liste(i) > Liste(j) Then temp2 = Liste(j) Liste(j) = Liste(i) Liste(i) = temp2 End If Next j Next i Else ' décroissant For i = LBound(Liste) To UBound(Liste) - 1 For j = i + 1 To UBound(Liste) If Liste(i) < Liste(j) Then temp2 = Liste(j) Liste(j) = Liste(i) Liste(i) = temp2 End If Next j Next i End If End Sub ' Test si l'annotation est visible (dans un calque visible) Function IsVisible(ByVal swAnnotation As Annotation) As Boolean Dim swLayerMgr As LayerMgr swLayerMgr = swDoc.GetLayerManager Dim swLayer As Layer swLayer = swLayerMgr.GetLayer(swAnnotation.Layer) If Not swLayer Is Nothing Then IsVisible = False Else IsVisible = True End If End Function ' Boucle sur les annotations Sub TraverseAnnotations(ByVal swDraw As DrawingDoc, ByVal blVisibility As Boolean) Dim swView As SolidWorks.Interop.sldworks.View Dim swAnnotation As Annotation Dim stList As String Dim k As Integer = 0 Dim j As Integer = 0 swView = swDraw.GetFirstView ' Fond de plan swView = swView.GetNextView ' premiere vue (evite les annotations du cartouche) Do swAnnotation = swView.GetFirstAnnotation3 Do Until swAnnotation Is Nothing If IsVisible(swAnnotation) = blVisibility Then 'stList = stList & vbCrLf & swAnnotation.GetName MessageBox.Show(swView.Name) swWeldSymbol = swView.GetFirstWeldSymbol While (Not swWeldSymbol Is Nothing) For j = 0 To swWeldSymbol.GetTextCount If (Microsoft.VisualBasic.Left(swWeldSymbol.GetTextAtIndex(j), 1) = "W" Or Microsoft.VisualBasic.Left(swWeldSymbol.GetTextAtIndex(j), 1) = "w") Then Tableau_Soudure(k) = swWeldSymbol.GetTextAtIndex(j) k = k + 1 End If Next j swWeldSymbol = swWeldSymbol.GetNext End While End If swAnnotation = swAnnotation.GetNext3 Loop swView = swView.GetNextView Loop Until swView Is Nothing ' Affiche la liste en fin de parcours 'swApp.SendMsgToUser2("Liste des annotations visible = " & CStr(blVisibility) & stList, swconst.swMessageBoxIcon_e.swMbWarning, swconst.swMessageBoxBtn_e.swMbOk) End Sub

par **liryc** » Ven 02 Mar 2012, 13:38

BOnjour,
Je n'aurai pas SW sous la main avant lundi et pas sûr d'avoir le temps de regarder.
Si quelqu'un d'autre passe sur le sujet pour regarder un peu.

par **rOhArT** » Ven 02 Mar 2012, 14:58

merci encore

par **liryc** » Lun 05 Mar 2012, 18:39

Je ne peux pas tester ton code (sûrement une différence de version de SW) donc je ne peux que t'aiguiller.
je pense qu'en modifiant:

Code: Tout sélectionner: swLayer = swLayerMgr.GetLayer(swAnnotation.Layer)

par

Code: Tout sélectionner: swLayer = swLayerMgr.GetCurrentLayer(swAnnotation.Layer)

ça devrait règler le problème.

par **rOhArT** » Mar 06 Mar 2012, 10:15

non car swLayer = swLayerMgr.GetCurrentLayer(swAnnotation.Layer

le débuggeur nous dit Impossible de convertir une valeur de type 'Char' en 'SolidWorks.Interop.sldworks.Layer'

merci quand même

par **rOhArT** » Mar 06 Mar 2012, 15:24

j'ai presque trouvé, j'ai modifié la procédure TraverseAnnotation comme ceci et ca marche à moitié je n'ai plus les soudures cachés mais ils m'en manque d'autres je suis sur la bonne voie

Code: Tout sélectionner: ' Boucle sur les annotations Sub TraverseAnnotations(ByVal swDraw As DrawingDoc, ByVal blVisibility As Boolean) Dim swView As SolidWorks.Interop.sldworks.View Dim swAnnotation As Annotation Dim k As Integer = 0 Dim j As Integer = 0 swView = swDraw.GetFirstView ' Fond de plan swView = swView.GetNextView ' premiere vue (evite les annotations du cartouche) Do swAnnotation = swView.GetFirstAnnotation3 Do Until swAnnotation Is Nothing If swAnnotation.GetType = swconst.swAnnotationType_e.swWeldSymbol Then If IsVisible(swAnnotation) = blVisibility Then swWeldSymbol = swAnnotation.GetSpecificAnnotation ' swView.GetFirstWeldSymbol ' While (Not swWeldSymbol Is Nothing) For j = 0 To swWeldSymbol.GetTextCount If swWeldSymbol.GetTextAtIndex(j).ToUpper.StartsWith("W") Then ' idem en plus court que (Microsoft.VisualBasic.Left(swWeldSymbol.GetTextAtIndex(j), 1) = "W" Or Microsoft.VisualBasic.Left(swWeldSymbol.GetTextAtIndex(j), 1) = "w") Tableau_Soudure(k) = swWeldSymbol.GetTextAtIndex(j) k = k + 1 End If Next j ' swWeldSymbol = swWeldSymbol.GetNext ' End While End If End If swAnnotation = swAnnotation.GetNext3 Loop swView = swView.GetNextView Loop Until swView Is Nothing End Sub

par **rOhArT** » Lun 12 Mar 2012, 10:45

un p'tit up

merci d'avance

par **rOhArT** » Mer 14 Mar 2012, 8:20

Bonjour,

Je viens vous dire que j'ai enfin résolu mon problème

Je vous met le code complet

Code: Tout sélectionner: Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim i = 0 Dim j = 0 Dim k = 0 swApp = GetObject(, "SldWorks.Application") If swApp Is Nothing Then MessageBox.Show("Veuillez ouvrir Solidworks avec le fichier qui contient les soudures") Exit Sub End If swModel = swApp.ActiveDoc swDwg = swModel swDwg.ClearSelection2(True) swSheet = swDwg.GetCurrentSheet swDwg.ActivateSheet(swSheet.GetName) swDoc = swApp.ActiveDoc ' En fonction du type de document Select Case swDoc.GetType Case swconst.swDocumentTypes_e.swDocDRAWING swDraw = swDoc Call TraverseAnnotations(swDraw, True) Case Else swApp.SendMsgToUser2("Cette macro ne fonctionne que sur une mise en plan", swconst.swMessageBoxIcon_e.swMbWarning, swconst.swMessageBoxBtn_e.swMbOk) End End Select 'For Each vLayer In vLayerArr ' swLayer = swLayerMgr.GetLayer(vLayer) ' MessageBox.Show(swLayer.Name) ' If swLayer.Visible = True Then ' swView = swDwg.GetFirstView ' While Not swView Is Nothing ' swWeldSymbol = swView.GetFirstWeldSymbol ' While Not swWeldSymbol Is Nothing ' i = i + 1 ' For j = 0 To swWeldSymbol.GetTextCount ' 'MsgBox (swWeldSymbol.GetTextAtIndex(j)) ' If Microsoft.VisualBasic.Left(swWeldSymbol.GetTextAtIndex(j), 1) = "W" Or Microsoft.VisualBasic.Left(swWeldSymbol.GetTextAtIndex(j), 1) = "w" Then ' Tableau_Soudure(k) = swWeldSymbol.GetTextAtIndex(j) ' k = k + 1 ' End If ' Next j ' swWeldSymbol = swWeldSymbol.GetNext ' End While ' swView = swView.GetNextView ' End While ' End If 'Next Call Tri(Tableau_Soudure, True) 'enléve les doublons For j = 0 To 1000 If j - 1 >= 0 Then If Tableau_Soudure(j - 1) = Tableau_Soudure(j) Then Tableau_Soudure(j - 1) = "" End If End If Next Call Tri(Tableau_Soudure, True) Dim monStreamWriter As StreamWriter = New StreamWriter("C:\Temp\essai.txt") 'on remplit le fichier texte For i = 0 To 1000 If Tableau_Soudure(i) <> "" Then monStreamWriter.WriteLine(Tableau_Soudure(i)) End If Next i 'fermeture du fichier texte monStreamWriter.Close() End Sub Private Sub Tri(ByRef Liste() As String, ByVal bASC As Boolean) Dim i As Long, j As Long Dim temp2 As String If bASC Then ' croissant For i = LBound(Liste) To UBound(Liste) - 1 For j = i + 1 To UBound(Liste) If Liste(i) > Liste(j) Then temp2 = Liste(j) Liste(j) = Liste(i) Liste(i) = temp2 End If Next j Next i Else ' décroissant For i = LBound(Liste) To UBound(Liste) - 1 For j = i + 1 To UBound(Liste) If Liste(i) < Liste(j) Then temp2 = Liste(j) Liste(j) = Liste(i) Liste(i) = temp2 End If Next j Next i End If End Sub ' Test si l'annotation est visible (dans un calque visible) Function IsVisible(ByVal swAnnotation As Annotation) As Boolean Dim swLayerMgr As LayerMgr swLayerMgr = swDoc.GetLayerManager Dim swLayer As Layer swLayer = swLayerMgr.GetLayer(swAnnotation.Layer) If Not swLayer Is Nothing Then 'And swLayer.Visible = False Then If swLayer.Visible = False Then IsVisible = False Else IsVisible = True End If Else IsVisible = True End If End Function ' Boucle sur les annotations Sub TraverseAnnotations(ByVal swDraw As DrawingDoc, ByVal blVisibility As Boolean) Dim swView As SolidWorks.Interop.sldworks.View Dim swAnnotation As Annotation Dim k As Integer = 0 Dim j As Integer = 0 swView = swDraw.GetFirstView ' Fond de plan swView = swView.GetNextView ' premiere vue (evite les annotations du cartouche) Do swAnnotation = swView.GetFirstAnnotation3 Do Until swAnnotation Is Nothing If swAnnotation.GetType = swconst.swAnnotationType_e.swWeldSymbol Then If IsVisible(swAnnotation) = blVisibility Then swWeldSymbol = swAnnotation.GetSpecificAnnotation ' swView.GetFirstWeldSymbol ' While (Not swWeldSymbol Is Nothing) For j = 0 To swWeldSymbol.GetTextCount If swWeldSymbol.GetTextAtIndex(j).ToUpper.StartsWith("W") Then ' idem en plus court que (Microsoft.VisualBasic.Left(swWeldSymbol.GetTextAtIndex(j), 1) = "W" Or Microsoft.VisualBasic.Left(swWeldSymbol.GetTextAtIndex(j), 1) = "w") Tableau_Soudure(k) = swWeldSymbol.GetTextAtIndex(j) k = k + 1 End If Next j ' swWeldSymbol = swWeldSymbol.GetNext ' End While End If End If swAnnotation = swAnnotation.GetNext3 Loop swView = swView.GetNextView Loop Until swView Is Nothing End Sub

par **Annwn** » Mer 14 Mar 2012, 12:14

Merci pour ton partage !

quel était le problème ?

Forum SolidWorks A-S3D

[RESOLU]repère de soudure

[RESOLU]repère de soudure

Qui est en ligne