| 1 |
Imports SolidWorks.Interop
|
| 2 |
Imports SolidWorks.Interop.swconst
|
| 3 |
Imports SolidWorks.Interop.swpublished
|
| 4 |
|
| 5 |
Namespace ConditionsAuxLimites
|
| 6 |
Module CLCode
|
| 7 |
|
| 8 |
Public AnnoSeul As Boolean
|
| 9 |
Public checkbox1 As SldWorks.PropertyManagerPageCheckbox
|
| 10 |
Public checkbox2 As SldWorks.PropertyManagerPageCheckbox
|
| 11 |
Public selection1 As SldWorks.PropertyManagerPageSelectionbox
|
| 12 |
Public combo1 As SldWorks.PropertyManagerPageCombobox
|
| 13 |
Public Numberbox1 As SldWorks.PropertyManagerPageNumberbox
|
| 14 |
|
| 15 |
Public DessinerCL As SldWorks.PropertyManagerPageCheckbox
|
| 16 |
|
| 17 |
''' <summary>
|
| 18 |
''' En théorie obsolète
|
| 19 |
''' </summary>
|
| 20 |
''' <param name="TypeCl"></param>
|
| 21 |
''' <param name="valeur"></param>
|
| 22 |
''' <param name="couleur"></param>
|
| 23 |
''' <param name="balon"></param>
|
| 24 |
''' <remarks></remarks>
|
| 25 |
Private Sub MettreNote(ByRef TypeCl As String, ByRef valeur As Double, ByRef couleur As Long, ByVal balon As Integer)
|
| 26 |
' prend toutes les entités sélectionnées et met une annotation dessu.
|
| 27 |
Dim Note As SldWorks.Note
|
| 28 |
Dim Annotation As SldWorks.Annotation
|
| 29 |
Dim TextFormat As Object = Nothing
|
| 30 |
Note = swPart.InsertNote(TypeCl & "," & valeur)
|
| 31 |
If Not Note Is Nothing Then
|
| 32 |
Note.Angle = 0
|
| 33 |
Note.SetBalloon(balon, 0)
|
| 34 |
Annotation = Note.GetAnnotation()
|
| 35 |
If Not Annotation Is Nothing Then
|
| 36 |
Annotation.SetLeader2(True, 0, True, True, False, False)
|
| 37 |
Annotation.SetPosition(0, 0, 0) ' coordonnées à évaluer
|
| 38 |
Annotation.SetTextFormat(0, True, TextFormat)
|
| 39 |
End If
|
| 40 |
|
| 41 |
End If
|
| 42 |
swPart.ClearSelection2(True)
|
| 43 |
|
| 44 |
End Sub
|
| 45 |
|
| 46 |
|
| 47 |
|
| 48 |
'Private Function addCaL(ByRef nom As String, ByRef cl As CaL) As String
|
| 49 |
' ' cette fonction prend un nom et ajoute une condition aux limites au nom.
|
| 50 |
' ' seul le nom est modidifié
|
| 51 |
' ' on a un nom, s'il n'a pas encore de conditions aux limites alors on doit ajouter un dièse et 01.
|
| 52 |
' Dim i As Integer
|
| 53 |
' Dim nb As Integer
|
| 54 |
' Dim c As Integer
|
| 55 |
|
| 56 |
' For i = 1 To Len(nom)
|
| 57 |
' If Mid(nom, i, 1) = "@" Then
|
| 58 |
' nb = Val(Mid(nom, i + 1, 2)) + 1
|
| 59 |
' Mid(nom, i + 1, 2) = Format(nb, "00")
|
| 60 |
' If cl.valeur >= 0 Then ' valeur positive
|
| 61 |
' nom = nom & cl.TypeCL & "+" & Format(cl.valeur, "0.00000e+000")
|
| 62 |
' Else
|
| 63 |
' nom = nom & cl.TypeCL & Format(cl.valeur, "0.00000e+000")
|
| 64 |
' End If
|
| 65 |
|
| 66 |
' For c = 1 To Len(nom)
|
| 67 |
' If Mid(nom, c, 1) = "," Then Mid(nom, c, 1) = "."
|
| 68 |
' Next c
|
| 69 |
' addCaL = nom
|
| 70 |
' Exit Function ' on a fait toutes les modifications
|
| 71 |
' End If
|
| 72 |
' Next i
|
| 73 |
|
| 74 |
' ' rajouter la première condition aux limites
|
| 75 |
' Dim valeur As String = Nothing
|
| 76 |
' If cl.valeur >= 0 Then valeur = "+" & Format(cl.valeur, "0.00000e+000")
|
| 77 |
' nom = nom & "@01" & cl.TypeCL & valeur
|
| 78 |
' 'MsgBox " Première Condition = " & nom
|
| 79 |
|
| 80 |
' ' remplacer une virgule par un point
|
| 81 |
' For c = 1 To Len(nom)
|
| 82 |
' If Mid(nom, c, 1) = "," Then Mid(nom, c, 1) = "."
|
| 83 |
' Next c
|
| 84 |
' addCaL = nom
|
| 85 |
|
| 86 |
'End Function
|
| 87 |
|
| 88 |
|
| 89 |
Public Sub inclure_sous_jacent() 'ByRef CLPage As SldWorks.PropertyManagerPage2)
|
| 90 |
Dim swEnt As SldWorks.Entity
|
| 91 |
Dim i As Integer
|
| 92 |
Dim SelMgr As SldWorks.SelectionMgr
|
| 93 |
|
| 94 |
SelMgr = swModel.SelectionManager
|
| 95 |
|
| 96 |
For i = 1 To SelMgr.GetSelectedObjectCount
|
| 97 |
swEnt = SelMgr.GetSelectedObject5(i)
|
| 98 |
Select Case swEnt.GetType
|
| 99 |
Case 2 ' une face
|
| 100 |
Dim swFace As SldWorks.Face2
|
| 101 |
swFace = swEnt
|
| 102 |
SelectSousJacent(swFace)
|
| 103 |
|
| 104 |
Case 1 ' arete
|
| 105 |
Dim swArete As SldWorks.Edge
|
| 106 |
swArete = swEnt
|
| 107 |
SelectSousJacent(swArete)
|
| 108 |
End Select
|
| 109 |
Next i
|
| 110 |
swModel.GraphicsRedraw()
|
| 111 |
|
| 112 |
'CLPage.Close(False)
|
| 113 |
'CLPage.Show()
|
| 114 |
|
| 115 |
|
| 116 |
End Sub
|
| 117 |
|
| 118 |
Private Overloads Sub SelectSousJacent(ByRef swFace As sldworks.Face2)
|
| 119 |
Dim swEnt As sldworks.Entity
|
| 120 |
Dim coa As Integer
|
| 121 |
Dim swLoop As sldworks.Loop2
|
| 122 |
|
| 123 |
swLoop = swFace.GetFirstLoop
|
| 124 |
Do While Not swLoop Is Nothing
|
| 125 |
|
| 126 |
Dim vArete As Object = swLoop.GetEdges()
|
| 127 |
For Each swArete As sldworks.Edge In vArete
|
| 128 |
'swEnt = swArete
|
| 129 |
'swEnt.Select3(True, 0, Nothing)
|
| 130 |
Dim e As New SuperArete(swArete, True) : e.SelectionnerSafe()
|
| 131 |
Call SelectSousJacent(swArete)
|
| 132 |
Next swArete ' fin de loop sur les coaretes
|
| 133 |
|
| 134 |
swLoop = swLoop.GetNext
|
| 135 |
Loop ' fin loop sur loop
|
| 136 |
|
| 137 |
End Sub
|
| 138 |
|
| 139 |
Private Overloads Sub SelectSousJacent(ByRef swArete As sldworks.Edge)
|
| 140 |
' l'arête est sélectionnée, il faut sélectionner ses sommets...
|
| 141 |
Dim sommet1 As sldworks.Vertex
|
| 142 |
Dim sommet2 As sldworks.Vertex
|
| 143 |
Dim swEnt As sldworks.Entity
|
| 144 |
|
| 145 |
sommet1 = swArete.GetStartVertex
|
| 146 |
|
| 147 |
If IsNothing(sommet1) Then Exit Sub ' courbe sans sommets
|
| 148 |
|
| 149 |
'swEnt = sommet1
|
| 150 |
'swEnt.Select2(True, Nothing)
|
| 151 |
Dim esom1 As New SuperSommet(sommet1, True) : esom1.SelectionnerSafe()
|
| 152 |
|
| 153 |
sommet2 = swArete.GetEndVertex
|
| 154 |
'swEnt = sommet2
|
| 155 |
'swEnt.Select2(True, Nothing)
|
| 156 |
Dim esom2 As New SuperSommet(sommet2, True) : esom2.SelectionnerSafe()
|
| 157 |
|
| 158 |
End Sub
|
| 159 |
|
| 160 |
|
| 161 |
''' <summary>
|
| 162 |
''' Sub qui prend les informations de la page de propriétés et qui en fait des conditions aux limites
|
| 163 |
''' </summary>
|
| 164 |
''' <remarks></remarks>
|
| 165 |
Public Sub enregistrer_CL()
|
| 166 |
Dim CL As EncapCL = Nothing
|
| 167 |
Dim tipe As String
|
| 168 |
Dim valeur As Double
|
| 169 |
Dim selMgr As SldWorks.SelectionMgr
|
| 170 |
Dim i As Integer
|
| 171 |
Dim swEnt As SldWorks.Entity
|
| 172 |
Dim n As Integer
|
| 173 |
|
| 174 |
tipe = Left(combo1.ItemText(combo1.CurrentSelection), 2)
|
| 175 |
valeur = Numberbox1.Value
|
| 176 |
|
| 177 |
Dim listeentite As New Collections.Generic.List(Of SldWorks.Entity)
|
| 178 |
Dim lstpoints() As Double = Nothing
|
| 179 |
selMgr = swModel.SelectionManager
|
| 180 |
|
| 181 |
For i = 1 To selMgr.GetSelectedObjectCount
|
| 182 |
If selMgr.GetSelectedObjectType2(i) = swconst.swSelectType_e.swSelPOINTREFS Then
|
| 183 |
' transformer la sélection d'un pointref en une sélection de vertex
|
| 184 |
Dim coords(2) As Double
|
| 185 |
Dim vretval As Object
|
| 186 |
vretval = selMgr.GetSelectionPoint(i)
|
| 187 |
coords = vretval
|
| 188 |
|
| 189 |
If lstpoints Is Nothing Then n = 0 Else n = UBound(lstpoints)
|
| 190 |
ReDim lstpoints(n + 3)
|
| 191 |
lstpoints(n + 0) = coords(0)
|
| 192 |
lstpoints(n + 1) = coords(1)
|
| 193 |
lstpoints(n + 2) = coords(2)
|
| 194 |
|
| 195 |
Else
|
| 196 |
listeentite.Add(selMgr.GetSelectedObject5(i))
|
| 197 |
End If
|
| 198 |
Next i
|
| 199 |
|
| 200 |
If lstpoints IsNot Nothing Then
|
| 201 |
For j As Integer = 0 To lstpoints.GetUpperBound(0) Step 3
|
| 202 |
If Not swModel.AndSelectByID(Nothing, "VERTEX", lstpoints(j + 0), lstpoints(j + 1), lstpoints(j + 2)) Then MsgBox("Échec")
|
| 203 |
Dim swsommet As SldWorks.Vertex
|
| 204 |
|
| 205 |
swModel.SelectAt(swconst.swSelectType_e.swSelVERTICES, lstpoints(j + 0), lstpoints(j + 1), lstpoints(j + 2))
|
| 206 |
swEnt = selMgr.GetSelectedObject5(1)
|
| 207 |
swsommet = swEnt
|
| 208 |
|
| 209 |
CL = New EncapCL(swsommet)
|
| 210 |
CL.AjouterCondition(tipe, valeur, IIf(CLCode.DessinerCL.Checked, True, False))
|
| 211 |
Next
|
| 212 |
End If
|
| 213 |
|
| 214 |
|
| 215 |
|
| 216 |
|
| 217 |
For Each swEnt In listeentite
|
| 218 |
If swEnt IsNot Nothing Then
|
| 219 |
retour:
|
| 220 |
Select Case swEnt.GetType
|
| 221 |
Case swconst.swSelectType_e.swSelVERTICES
|
| 222 |
Dim swSommet As SldWorks.Vertex
|
| 223 |
swSommet = swEnt
|
| 224 |
CL = New EncapCL(swSommet)
|
| 225 |
|
| 226 |
Case swconst.swSelectType_e.swSelEDGES
|
| 227 |
Dim swArete As SldWorks.Edge
|
| 228 |
swArete = swEnt
|
| 229 |
CL = New EncapCL(swArete)
|
| 230 |
|
| 231 |
Case swconst.swSelectType_e.swSelFACES
|
| 232 |
Dim swFace As SldWorks.Face2
|
| 233 |
swFace = swEnt
|
| 234 |
CL = New EncapCL(swFace)
|
| 235 |
Case swconst.swSelectType_e.swSelATTRIBUTES
|
| 236 |
Dim attr As SldWorks.Attribute = swEnt
|
| 237 |
swEnt = attr.GetEntity2()
|
| 238 |
GoTo retour
|
| 239 |
Case Else
|
| 240 |
'MsgBox("Une entité sélectionnée ne peut avoir de condition aux limites -->" & selMgr.GetSelectedObjectType2(i))
|
| 241 |
|
| 242 |
End Select
|
| 243 |
CL.AjouterCondition(tipe, valeur, IIf(CLCode.DessinerCL.Checked, True, False))
|
| 244 |
End If
|
| 245 |
|
| 246 |
Next swEnt
|
| 247 |
End Sub
|
| 248 |
|
| 249 |
End Module
|
| 250 |
End Namespace |
