X2021/Wardrobe/SolidWorks/Multiple_Drawing.vb

323 lines
13 KiB
VB.net

Imports SldWorks
Public Class Multiple_Drawing
Public Shared Sub Create_Models_For_Drawing()
Dim gratingsPointsDS As DataSet = Create_GratingPoints()
Dim gratingHeight As Decimal = User_Input.gratingHeight / 1000
Dim swApp As SldWorks.SldWorks
swApp = CType(System.Runtime.InteropServices.Marshal.GetActiveObject("SldWorks.Application"), SldWorks.SldWorks)
Dim Model As ModelDoc2
Dim RootPoint(2) As Double
Dim Normal(2) As Double
swApp.UserControl = True
Dim swSkMgr As SketchManager
Dim longstatus As Integer
Dim boolstatus As Boolean
Dim swModelDocExtension As ModelDocExtension
Dim status As Boolean
Dim swFeatureMgr As FeatureManager
Dim swFeature As Feature
Dim iPart As PartDoc
Dim numOfGratings As Integer = Grating_Fill.numOfVertical * Grating_Fill.numOfHorizontal
For i = 0 To numOfGratings - 1
Model = swApp.NewDocument("C:\ProgramData\SOLIDWORKS\SOLIDWORKS 2020\templates\part.prtdot", 0, 0, 0)
swSkMgr = Model.SketchManager
swSkMgr.InsertSketch(True)
boolstatus = Model.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
Model.ClearSelection2(True)
For Each DR As DataRow In gratingsPointsDS.Tables(i).Rows
Dim skPoint As SketchPoint
Dim pX = DR("X")
Dim pY = DR("Y")
skPoint = swSkMgr.CreatePoint(pX, pY, 0)
Next
For Each DR1 As DataRow In gratingsPointsDS.Tables(i).Rows
Dim skLine As SketchLine
Dim rowIndex = gratingsPointsDS.Tables(i).Rows.IndexOf(DR1)
Dim DR2 As DataRow
Try
DR2 = gratingsPointsDS.Tables(i).Rows(rowIndex + 1)
Catch ex As Exception
DR2 = gratingsPointsDS.Tables(i).Rows(0)
End Try
Dim pX1 = DR1("X")
Dim pY1 = DR1("Y")
Dim pX2 = DR2("X")
Dim pY2 = DR2("Y")
skLine = swSkMgr.CreateLine(pX1, pY1, 0, pX2, pY2, 0)
Next
swSkMgr.InsertSketch(True)
swModelDocExtension = Model.Extension
status = swModelDocExtension.SelectByID2("Sketch1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
swFeatureMgr = Model.FeatureManager
swFeature = swFeatureMgr.FeatureExtrusion3(True, False, False, 0, 0, gratingHeight, 0, False, False, False, False, 0, 0, False, False, False, False, True, True, True, 0, 0, False)
' MIddle points if needed
Model.ClearSelection2(True)
boolstatus = Model.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
Model.FeatureManager.InsertRefPlane(8, gratingHeight, 0, 0, 0, 0)
iPart = swApp.ActiveDoc
Dim newName As String
newName = Settings.folderPaths("object_" & Data.objectNum & "_models3D_gratings_sw_support") & "\simplified_grating_" & i + 1 & ".SLDPRT"
' Title head data
longstatus = iPart.SaveAs3(newName, 0, 0)
swApp.CloseDoc(newName)
Next
' --- Assembly ---
Dim assembly As IAssemblyDoc
Model = swApp.NewDocument("C:\ProgramData\SolidWorks\SOLIDWORKS 2020\templates\Assembly.asmdot", 0, 0, 0)
assembly = Model
Dim compNames(numOfGratings - 1) As String
Dim coordNames(numOfGratings - 1) As String
Dim transMatrix As Object = Nothing
For i = 0 To numOfGratings - 1
compNames(i) = Settings.folderPaths("object_" & Data.objectNum & "_models3D_gratings_sw_support") & "\simplified_grating_" & i + 1 & ".SLDPRT"
coordNames(i) = ""
Next
Dim assemComps As Object
assemComps = assembly.AddComponents3((compNames), (transMatrix), (coordNames))
longstatus = Model.SaveAs3(Settings.folderPaths("object_" & Data.objectNum & "_models3D_gratings_sw_support") & "\simplified_grating_assembly.SLDASM", 0, 0)
End Sub
Private Shared Function Create_GratingPoints()
Dim pointsDS As New DataSet
Dim numOfGratings As Integer = Grating_Fill.numOfVertical * Grating_Fill.numOfHorizontal
For i = 0 To numOfGratings - 1
Dim pointsDT As New DataTable
pointsDT.Columns.Add("NAME", GetType(String))
pointsDT.Columns.Add("TYPE", GetType(String))
pointsDT.Columns.Add("X", GetType(Double))
pointsDT.Columns.Add("Y", GetType(Double))
' --- Determine grossArea points ----
Dim pX(3) As Double
Dim pY(3) As Double
Dim columnNum As Integer = (i + Grating_Fill.numOfHorizontal) Mod Grating_Fill.numOfHorizontal
If columnNum <> (Grating_Fill.numOfHorizontal - 1) Then
' Columnn: alla utom sista
pX(0) = Data.grossAreaPoints.Rows(0)("X") + Grating_Fill.minLength * columnNum / 1000
pX(1) = pX(0) + Grating_Fill.minLength / 1000
pX(2) = pX(1)
pX(3) = pX(0)
Else
' Column: sista
pX(0) = Data.grossAreaPoints.Rows(0)("X") + Grating_Fill.minLength * columnNum / 1000
pX(1) = Data.grossAreaPoints.Rows(1)("X")
pX(2) = pX(1)
pX(3) = pX(0)
End If
Dim rowNum As Integer = Math.Floor(i / Grating_Fill.numOfHorizontal)
If rowNum < Grating_Fill.numOfVertical - 2 Then
' Row: alla utom sista och näst sista
pY(0) = Data.grossAreaPoints.Rows(0)("Y") - Grating_Fill.maxSingleWidth * rowNum / 1000
pY(1) = pY(0)
pY(2) = pY(0) - Grating_Fill.maxSingleWidth / 1000
pY(3) = pY(2)
ElseIf rowNum < Grating_Fill.numOfVertical - 1 Then
' Row: Näst sista
pY(0) = Data.grossAreaPoints.Rows(0)("Y") - Grating_Fill.maxSingleWidth * rowNum / 1000
pY(1) = pY(0)
If Grating_Fill.widthRevNeeded = True Then
pY(2) = pY(0) - Grating_Fill.revWidth / 1000
Else
pY(2) = pY(0) - Grating_Fill.maxSingleWidth / 1000
End If
pY(3) = pY(2)
Else
' Row: Sista
If Grating_Fill.widthRevNeeded = True Then
pY(0) = Data.grossAreaPoints.Rows(0)("Y") - Grating_Fill.maxSingleWidth * (rowNum - 1) / 1000 - Grating_Fill.revWidth / 1000
Else
pY(0) = Data.grossAreaPoints.Rows(0)("Y") - Grating_Fill.maxSingleWidth * rowNum / 1000
End If
pY(1) = pY(0)
pY(2) = Data.grossAreaPoints.Rows(3)("Y")
pY(3) = pY(2)
End If
For j = 0 To 3
Dim DR As DataRow = pointsDT.NewRow()
DR("NAME") = "GA_" & j + 1
DR("TYPE") = "GA"
DR("X") = pX(j)
DR("Y") = pY(j)
pointsDT.Rows.Add(DR)
Next
' --- Add recess points ---
Dim recessPointsDT As New DataTable
recessPointsDT.Columns.Add("NAME", GetType(String))
recessPointsDT.Columns.Add("TYPE", GetType(String))
recessPointsDT.Columns.Add("SIDE", GetType(Integer))
recessPointsDT.Columns.Add("X", GetType(Double))
recessPointsDT.Columns.Add("Y", GetType(Double))
For j = 1 To 4
For Each DR As DataRow In Data.gratingPoints.Rows
Dim recessDR As DataRow = recessPointsDT.NewRow()
recessDR("NAME") = DR("NAME")
recessDR("SIDE") = j
recessDR("X") = DR("X")
recessDR("Y") = DR("Y")
Dim pointName As String = DR("NAME")
If pointName.Substring(0, 2) = "CA" Then
recessDR("TYPE") = "Corner Angle"
ElseIf pointName.Substring(0, 2) = "CR" Then
recessDR("TYPE") = "Corner Rectangle"
ElseIf pointName.Substring(0, 2) = "CS" Then
recessDR("TYPE") = "Side Rectangle"
Else
Continue For
End If
If j = 1 Then
If DR("Y") = pointsDT.Rows(0)("Y") Then
If DR("X") >= pointsDT.Rows(0)("X") AndAlso DR("X") <= pointsDT.Rows(1)("X") Then
recessPointsDT.Rows.Add(recessDR)
End If
End If
ElseIf j = 2 Then
If DR("X") = pointsDT.Rows(1)("X") Then
If DR("Y") <= pointsDT.Rows(1)("Y") AndAlso DR("Y") >= pointsDT.Rows(2)("Y") Then
recessPointsDT.Rows.Add(recessDR)
End If
End If
ElseIf j = 3 Then
If DR("Y") = pointsDT.Rows(2)("Y") Then
If DR("X") <= pointsDT.Rows(2)("X") AndAlso DR("X") >= pointsDT.Rows(3)("X") Then
recessPointsDT.Rows.Add(recessDR)
End If
End If
Else
If DR("X") = pointsDT.Rows(3)("X") Then
If DR("Y") >= pointsDT.Rows(3)("Y") AndAlso DR("Y") <= pointsDT.Rows(0)("Y") Then
recessPointsDT.Rows.Add(recessDR)
End If
End If
End If
Next
Next
For Each DR As DataRow In recessPointsDT.Rows
If DR("TYPE") = "Corner Angle" Then
Dim pointName As String = DR("NAME")
If pointName.Split("_")(1) = 1 Then
Dim DR3 As DataRow = pointsDT.NewRow()
DR3("NAME") = DR("NAME")
DR3("TYPE") = "Recess CA"
DR3("X") = DR("X")
DR3("Y") = DR("Y")
Dim index As Integer = Get_RowIndex(pointsDT, DR)
pointsDT.Rows.InsertAt(DR3, index + 1)
Try
pointsDT.Rows.RemoveAt(index + 2)
Catch ex As Exception
pointsDT.Rows.RemoveAt(0)
End Try
'Check if remove next point aswell (If angle crosses more than one grating)
Else
End If
End If
Next
pointsDT.TableName = "Grating " & i & " - C" & columnNum & " R" & rowNum
pointsDS.Tables.Add(pointsDT)
Next
Return pointsDS
End Function
Private Shared Function Get_RowIndex(pDT As DataTable, rpDR As DataRow)
Dim rowName As String = ""
If rpDR("SIDE") = 1 Then
Dim sidePoints = pDT.Select("Y = '" & rpDR("Y") & "'")
For Each DR2 As DataRow In sidePoints
If DR2("X") < rpDR("X") Then
rowName = DR2("NAME")
Else
Exit For
End If
Next
ElseIf rpDR("SIDE") = 2 Then
Dim sidePoints = pDT.Select("X = '" & rpDR("X") & "'")
For Each DR2 As DataRow In sidePoints
If DR2("Y") > rpDR("Y") Then
rowName = DR2("NAME")
Else
Exit For
End If
Next
ElseIf rpDR("SIDE") = 3 Then
Dim sidePoints = pDT.Select("Y = '" & rpDR("Y") & "'")
For Each DR2 As DataRow In sidePoints
If DR2("X") > rpDR("X") Then
rowName = DR2("NAME")
Else
Exit For
End If
Next
Else
Dim sidePoints = pDT.Select("X = '" & rpDR("X") & "'")
For Each DR2 As DataRow In sidePoints
If DR2("Y") < rpDR("Y") Then
rowName = DR2("NAME")
Else
Exit For
End If
Next
End If
Dim index As Integer = 0
For j = 0 To pDT.Rows.Count - 1
If pDT.Rows(j)("NAME") = rowName Then
index = j
Exit For
End If
Next
Return index
End Function
End Class