1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
| Public swApp, Classeur As Object
Public Occupe As Boolean
Public Massprops As Variant
Sub macro()
'**************************************
'Lien unidirectionnel Excel->Solidworks
'**************************************
'Déclarer les variables
Dim swApp As Object
Dim Part As Object
Const swDocPART = 1 ' These definitions are consistent with type names
Const swMaterialPropertyDensity = 7 ' defined in swconst.bas
Set swApp = CreateObject("SldWorks.Application")
Set Part = swApp.ActiveDoc ' Get handle to the active SolidWorks part
'**********************************************
'MODIFIER LA DENSITE DE LA PIECE
'**********************************************
Set xl = GetObject(, "Excel.Application")
Set Xlsh = xl.ActiveSheet
'Remplacer la valeur de la densité par la valeur inscrite dans la cellule C5
Density = Xlsh.Cells(5, 3)
'Recalculer la masse avec la nouvelle densité
Part.SetUserPreferenceDoubleValue swMaterialPropertyDensity, Density
'********************************************
'MODIFIER UNE COTE DE LA PIECE
'********************************************
Set swApp = CreateObject("SldWorks.Application")
Set Part = swApp.ActiveDoc
'Remplacer la valeur h de la cote par la valeur de la cellule C1
'Remplacer la valeur L de la cote par la valeur de la cellule C2
'Remplacer la valeur e de la cote par la valeur de la cellule C3
retval = Model.Parameter("h@Esquisse1@model exemple 1.Part").Setvalue2(Feuil1.Range("C1").Value, 1)
retval = Model.Parameter("L@Esquisse1@model exemple 1.Part").Setvalue2(Feuil1.Range("C2").Value, 1)
retval = Model.Parameter("e@Base-Extrusion@Model exemple 1.Part").Setvalue2(Feuil1.Range("C3").Value, 1)
'Reconstruire la pièce,vue isométrique et faire un zoom au mieux
Model.EditRebuild
Part.ShowNamedView2 "*Isométrique", 7
Part.ViewZoomtofit2
'**************************************
'Lien unidirectionnel Solidworks->Excel
'**************************************
Set swApp = CreateObject("SldWorks.Application")
Set xlApp = GetObject(, "Excel.Application")
Set Part = swApp.ActiveDoc
Set Xlsh = xlApp.Application.ActiveSheet
'**********************************************
'RENVOYER LES PROPRIETES DE LA PIECE DANS EXCEL
'**********************************************
Massprops = Model.GetMassProperties
'Renvoyer la coordonnée du centre de gravité
'selon l'axe X dans la cellule D7
Range("D7").Value = Massprops(0)
'Renvoyer la coordonnée du centre de gravité
'selon l'axe Y dans la cellule D8
Range("D8").Value = Massprops(1)
'Renvoyer la coordonnée du centre de gravité
'selon l'axe Z dans la cellule D9
Range("D9").Value = Massprops(2)
'Renvoyer le Volume de la pièce
'dans la cellule C11
Range("C11").Value = Massprops(3)
'Renvoyer la superficie de la pièce
'dans la cellule C12
Range("C12").Value = Massprops(4)
'Renvoyer la masse de la pièce
'dans la cellule C13
Range("C13").Value = Massprops(5)
'Renvoyer le Moment d'inertie Lxx: ( grammes * millimètres carrés)
'Pris au centre de gravité dans la cellule G8
Range("G8").Value = Massprops(6)
'Renvoyer le Moment d'inertie Lyy: ( grammes * millimètres carrés)
'Pris au centre de gravité dans la cellule H9
Range("H9").Value = Massprops(7)
'Renvoyer le Moment d'inertie Lzz: ( grammes * millimètres carrés)
'Pris au centre de gravité dans la cellule I10
Range("I10").Value = Massprops(8)
'Renvoyer le Moment d'inertie Lxy et Lyx: ( grammes * millimètres carrés)
'Pris au centre de gravité dans la cellule G9 et H8
Range("G9").Value = Massprops(9)
Range("H8").Value = Massprops(9)
'Renvoyer le Moment d'inertie Lxz et Lzx: ( grammes * millimètres carrés)
'Pris au centre de gravité dans la cellule G10 et I8
Range("G10").Value = Massprops(10)
Range("I8").Value = Massprops(10)
'Renvoyer le Moment d'inertie Lyz et Lzy: ( grammes * millimètres carrés)
'Pris au centre de gravité dans la cellule H10 et I9
Range("H10").Value = Massprops(11)
Range("I9").Value = Massprops(11)
End Sub |
Partager