Option Explicit

Dim swApp              As Object
Dim Part               As Object
Dim skSegment          As Object
Dim boolstatus         As Boolean
Dim longstatus         As Long

Dim tabx(1000)         As Double
Dim taby(1000)         As Double
Dim tabz(1000)         As Double

Dim length             As Double
Dim boole              As Boolean
Dim n                  As Integer
Dim radius             As Double
Dim securityradius     As Double
Dim dist               As Double

Dim MatrixVolume       As Integer
Dim FibersVolume       As Integer
Dim MatrixVolumeFract  As Double
Dim FibersVolumeFract  As Double
Dim MatrixVolumeFractP As Integer
Dim FibersVolumeFractP As Integer
Dim EffectiveTC        As Double
Dim err                As Long
Dim war                As Long
Dim bool               As Boolean
Dim name               As String
Dim swmodel            As Object
Dim chemin_dossier     As String


Private Sub LengthTextBox_Enter()

'Delete indication text
If LengthTextBox.Value = "Length of RVE" Then
LengthTextBox.Value = ""
End If

End Sub

Private Sub RadiusTextBox_Enter()

'Delete indication text
If RadiusTextBox.Value = "Radius of inclusions" Then
RadiusTextBox.Value = ""
End If

End Sub

Private Sub NumbersTextBox_Enter()

'Delete indication text
If NumbersTextBox.Value = "Numbers of inclusions" Then
NumbersTextBox.Value = ""
End If

End Sub

Private Sub CalculateButton_Click()

If LengthTextBox.Value = "Length of RVE" Or LengthTextBox.Value = "" Or RadiusTextBox.Value = "Radius of inclusions" Or RadiusTextBox.Value = "" Or NumbersTextBox.Value = "Numbers of inclusions" Or NumbersTextBox.Value = "" Then
MsgBox "Please fill all the fields !", vbCritical, "Error"
Else

'Show calculate zone
UserForm1.Height = 489.75

'Calculate volume fraction
MatrixVolume = LengthTextBox.Value * LengthTextBox.Value * LengthTextBox.Value
FibersVolume = (4 * Atn(1)) * (RadiusTextBox.Value ^ 2) * LengthTextBox.Value * NumbersTextBox.Value

FibersVolumeFract = FibersVolume / MatrixVolume
MatrixVolumeFract = 1 - FibersVolumeFract

MatrixVolumeFractP = MatrixVolumeFract * 100
FibersVolumeFractP = FibersVolumeFract * 100

MatrixV.Caption = MatrixVolume
FibersV.Caption = FibersVolume
MatrixVF.Caption = MatrixVolumeFractP
FibersVF.Caption = FibersVolumeFractP

'Calculate decimal thermal conductivity and round at 2
EffectiveTC = (TCF.Value * FibersVolumeFract) + (TCM.Value * MatrixVolumeFract)
ETC.Caption = Int(EffectiveTC * 10 ^ 2 + 1 / 2) / 10 ^ 2

End If

End Sub

Private Sub GenerateButton_Click()

'Enregistrement
'identifier le chemin du dossier
chemin_dossier = "C:\Users\Kader\Desktop\test"
'vérifier l'existence du dossier et le créer
If Dir(chemin_dossier, vbDirectory) <> vbNullString Then
    'dossier exuste
    'ne rien faire
Else
    'dossier n'existe pas, le créer
    MkDir (chemin_dossier)
End If

If LengthTextBox.Value = "Length of RVE" Or LengthTextBox.Value = "" Or RadiusTextBox.Value = "Radius of inclusions" Or RadiusTextBox.Value = "" Or NumbersTextBox.Value = "Numbers of inclusions" Or NumbersTextBox.Value = "" Then
MsgBox "Please fill all the fields !", vbCritical, "Error"
Else

'open new part
Set swApp = Application.SldWorks
Set Part = swApp.NewDocument("C:\ProgramData\SOLIDWORKS\SOLIDWORKS 2018\templates\Pièce.prtdot", 0, 0, 0)

'3D sketch
Part.SketchManager.Insert3DSketch (True)

'number of cylinder
n = NumbersTextBox.Value

'length and radius
length = LengthTextBox.Value / 1000
radius = RadiusTextBox.Value / 1000
securityradius = radius * 1.2

'random generate and no overlap
Dim i, j As Integer
For i = 1 To n
Randomize Timer
tabx(i) = Rnd * (length - securityradius * 2) + securityradius  'x position
taby(i) = Rnd * (length - securityradius * 2) + securityradius  'y position
boole = 0
If (i <> 1) Then
For j = 1 To i - 1
dist = Sqrt((tabx(i) - tabx(j)) ^ 2 + (taby(i) - taby(j)) ^ 2)
If (dist < 2.2 * radius) Then boole = 1
Next j
End If

'add point
If (boole = 0) Then
Dim skPoint As Object
Set skPoint = Part.SketchManager.CreatePoint(tabx(i), taby(i), tabz(i))
'MsgBox tabx(i) & " " & taby(i) & " " & tabz(i)
Else
i = i - 1
End If
Next i

'circle insertion
Set Part = swApp.ActiveDoc
Part.SketchManager.InsertSketch True
boolstatus = Part.Extension.SelectByID2("Plan de face", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
Dim skSegment As Object
Set skSegment = Part.SketchManager.CreateCircle(0#, 0#, 0#, radius, 0#, 0#)

'circle extrusion
Dim myFeature As Object
Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, length, length, False, False, False, False, 0.01, 0.01, False, False, False, False, True, True, True, 0, 0, False)

'repetition by sketch
boolstatus = Part.Extension.SelectByID2("Esquisse3D1", "SKETCH", 0, 0, 0, False, 64, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Boss.-Extru.1", "SOLIDBODY", 0, 0, 0, True, 256, Nothing, 0)
Part.FeatureManager.FeatureSketchDrivenPattern True, False

'delete the first revolution
boolstatus = Part.Extension.SelectByID2("Boss.-Extru.1", "SOLIDBODY", 0, 0, 0, True, 0, Nothing, 0)
Set myFeature = Part.FeatureManager.InsertDeleteBody2(False)

'hide the 3D sketch
boolstatus = Part.Extension.SelectByID2("Esquisse3D1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Part.BlankSketch
' Save As REV
longstatus = Part.SaveAs3("C:\Users\Kader\Desktop\test\RVE.SLDPRT", 0, 2)

Set swmodel = swApp.ActiveDoc
name = "RVE"
bool = swmodel.Extension.SaveAs(name + ".sldprt", 0, 1, Nothing, err, war)

End If

'----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

' CUBE

' New Document part
Set Part = swApp.NewDocument("C:\ProgramData\SOLIDWORKS\SOLIDWORKS 2018\templates\Pièce.prtdot", 0, 0, 0)

boolstatus = Part.Extension.SelectByID2("Plan de face", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
Dim vSkLines As Variant
vSkLines = Part.SketchManager.CreateCornerRectangle(0, 0, 0, 0.01, 0.01, 0)

'Dim myFeature As Object
Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 6, 0, length, length, False, False, False, False, 0, 0, False, False, False, False, True, True, True, 0, 0, False)
Part.ClearSelection2 True
' Save As CUBE
longstatus = Part.SaveAs3("C:\Users\Kader\Desktop\test\CUBE.SLDPRT", 0, 2)

Set swmodel = swApp.ActiveDoc
name = "CUBE"
bool = swmodel.Extension.SaveAs(name + ".sldprt", 0, 1, Nothing, err, war)

'----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

' Ass

' New Document
Set swApp = Application.SldWorks
Set Part = swApp.NewDocument("C:\ProgramData\SolidWorks\SOLIDWORKS 2018\templates\Assemblage.asmdot", 0, 0, 0)

' Insert Component CUBE
Dim swInsertedComponent As Component2
Set swInsertedComponent = Part.AddComponent5("C:\Users\Kader\Desktop\test\CUBE.SLDPRT", 0, "", False, "", 0, 0, 0)
'swApp.CloseDoc "C:\Users\Kader\Desktop\test vba\CUBE.SLDPRT"

' Insert Component REV
Set swInsertedComponent = Part.AddComponent5("C:\Users\Kader\Desktop\test\RVE.SLDPRT", 0, "", False, "", 0, 0, 0)
'swApp.CloseDoc "C:\Users\Kader\Desktop\test vba\REV.SLDPRT"

' Named View
Part.ShowNamedView2 "*Isométrique", 7
Part.ViewZoomtofit2

' Save As CUBE
longstatus = Part.SaveAs3("C:\Users\Kader\Desktop\test\Projet7.sldasm", 0, 2)

Set swmodel = swApp.ActiveDoc
name = "Projet7"
bool = swmodel.Extension.SaveAs(name + ".sldasm", 0, 1, Nothing, err, war)


End Sub