Imports SldWorks Public Class Individual_Drawing Private Shared sideCounter As Integer() Public Shared Sub Generate_Drawing() Dim pointTable As DataTable pointTable = Data.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 'Create a new blank document Model = swApp.NewDocument("C:\ProgramData\SOLIDWORKS\SOLIDWORKS 2020\templates\part.prtdot", 0, 0, 0) Dim swSkMgr As SketchManager Dim longstatus As Integer Dim boolstatus As Boolean 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 pointTable.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 pointTable.Rows Dim skLine As SketchLine Dim rowIndex = pointTable.Rows.IndexOf(DR1) Dim DR2 As DataRow Try DR2 = pointTable.Rows(rowIndex + 1) Catch ex As Exception DR2 = pointTable.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) Dim swModelDocExtension As ModelDocExtension swModelDocExtension = Model.Extension Dim status As Boolean status = swModelDocExtension.SelectByID2("Sketch1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0) Dim swFeatureMgr As FeatureManager swFeatureMgr = Model.FeatureManager Dim swFeature As Feature 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) For i = 0 To Data.gratingMiddlePoints.Rows.Count / 4 - 1 Model.ClearSelection2(True) boolstatus = Model.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0) swSkMgr.InsertSketch(True) Model.ClearSelection2(True) For j = 0 To 3 Dim skPoint As SketchPoint Dim pX = Data.gratingMiddlePoints.Rows(i * 4 + j)("X") Dim pY = Data.gratingMiddlePoints.Rows(i * 4 + j)("Y") skPoint = swSkMgr.CreatePoint(pX, pY, 0) Next For j = 0 To 3 Dim skLine As SketchLine Dim pX1 = Data.gratingMiddlePoints.Rows(i * 4 + j)("X") Dim pY1 = Data.gratingMiddlePoints.Rows(i * 4 + j)("Y") Dim pX2, pY2 As Double If j = 3 Then pX2 = Data.gratingMiddlePoints.Rows(i * 4)("X") pY2 = Data.gratingMiddlePoints.Rows(i * 4)("Y") Else pX2 = Data.gratingMiddlePoints.Rows(i * 4 + j + 1)("X") pY2 = Data.gratingMiddlePoints.Rows(i * 4 + j + 1)("Y") End If skLine = swSkMgr.CreateLine(pX1, pY1, 0, pX2, pY2, 0) Next swSkMgr.InsertSketch(True) status = swModelDocExtension.SelectByID2("Sketch" & i + 2, "SKETCH", 0, 0, 0, False, 0, Nothing, 0) swFeature = swFeatureMgr.FeatureCut4(True, False, False, 6, 0, gratingHeight * 4, 0.01, False, False, False, False, 0.01, 0.01, False, False, False, False, False, True, True, True, True, False, 0, 0, False, False) Next 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) Dim iPart As PartDoc iPart = swApp.ActiveDoc Dim newName As String newName = Settings.folderPaths("object_" & Data.objectNum & "_models3D_gratings_sw_support") & "\simplified_grating.SLDPRT" Dim config As Configuration config = iPart.GetActiveConfiguration Dim swCustPropMgr = config.CustomPropertyManager status = swCustPropMgr.Add3("Benämning", 30, "Floor grating " & User_Input.gratingMesh & " " & User_Input.gratingHeight & "/" & User_Input.loadBarThickness, 1) status = swCustPropMgr.Add3("ExtraBenämning1", 30, "LxW " & Data.gratingL & "x" & Data.gratingW, 1) If User_Input.gratingSerrated Then status = swCustPropMgr.Add3("ExtraBenämning2", 30, "Serrated", 1) Else status = swCustPropMgr.Add3("ExtraBenämning2", 30, "", 1) End If If User_Input.gratingLacquered Then status = swCustPropMgr.Add3("Materialsort", 30, User_Input.gratingMaterial & " (Lacquered)", 1) Else status = swCustPropMgr.Add3("Materialsort", 30, User_Input.gratingMaterial, 1) End If status = swCustPropMgr.Add3("Art. Nr", 30, "TBD", 1) status = swCustPropMgr.Add3("Material_Art", 30, "TBD", 1) status = swCustPropMgr.Add3("Author", 30, "", 1) status = swCustPropMgr.Add3("Ändrad av", 30, "", 1) status = swCustPropMgr.Add3("SkapadDatum", 30, "", 1) status = swCustPropMgr.Add3("RevideradDatum", 30, "", 1) status = swCustPropMgr.Add3("epdmid", 30, "", 1) status = swCustPropMgr.Add3("Revision", 30, "", 1) longstatus = iPart.SaveAs3(newName, 0, 0) Model.ClearSelection2(True) Create_Drawing(iPart) End Sub Private Shared Sub Create_Drawing(iModel As SldWorks.IModelDoc2) sideCounter = {0, 0, 0, 0} Dim swApp As SldWorks.SldWorks swApp = CType(System.Runtime.InteropServices.Marshal.GetActiveObject("SldWorks.Application"), SldWorks.SldWorks) Dim iPart As PartDoc iPart = swApp.ActiveDoc Dim iDrawing As DrawingDoc Dim swSheetWidth As Double swSheetWidth = 0.42 Dim swSheetHeight As Double swSheetHeight = 0.297 iDrawing = swApp.NewDocument("C:\ProgramData\SolidWorks\SOLIDWORKS 2020\templates\Drawing.drwdot", 12, swSheetWidth, swSheetHeight) Dim swSheet As Sheet swSheet = iDrawing.GetCurrentSheet() swSheet.SetProperties2(12, 12, 1, 1, False, swSheetWidth, swSheetHeight, True) swSheet.SetTemplateName(Settings.HLCtFolder & "\Files Needed\A3 Part.slddrt") swSheet.ReloadTemplate(True) Dim layMgr As LayerMgr layMgr = iDrawing.GetLayerManager() Dim status As Boolean status = layMgr.SetCurrentLayer("Svenska") Dim myView As View myView = iDrawing.CreateDrawViewFromModelView3(Settings.folderPaths("object_" & Data.objectNum & "_models3D_gratings_sw_support") & "\simplified_grating.SLDPRT", "*Front", swSheetWidth / 2, swSheetHeight / 2, 0) myView.UseSheetScale() = True Dim viewScale1, viewScale2 As Double Dim lengthForDrawing As Integer = Data.gratingL Dim widthForDrawing As Integer = Data.gratingW If lengthForDrawing < widthForDrawing * 3 Then 'W styr If widthForDrawing < 100 Then viewScale1 = 1 viewScale2 = 1 ElseIf widthForDrawing < 200 Then viewScale1 = 1 viewScale2 = 2 ElseIf widthForDrawing < 500 Then viewScale1 = 1 viewScale2 = 5 Else viewScale1 = 1 viewScale2 = 10 End If Else If lengthForDrawing < 300 Then viewScale1 = 1 viewScale2 = 1 ElseIf lengthForDrawing < 600 Then viewScale1 = 1 viewScale2 = 2 ElseIf lengthForDrawing < 1500 Then viewScale1 = 1 viewScale2 = 5 ElseIf lengthForDrawing < 3000 Then viewScale1 = 1 viewScale2 = 10 Else viewScale1 = 1 viewScale2 = 20 End If End If swSheet.SetScale(viewScale1, viewScale2, False, False) Dim swExtensions As SldWorks.ModelDocExtension swExtensions = iDrawing.Extension Dim RootComp = myView.RootDrawingComponent Dim CompName = RootComp.Name Dim sortedMeasurments As New Dictionary(Of String, Integer()) Dim numOfMes As Integer = Data.pointsMeasurements.Count sortedMeasurments.Add("Lmes", Data.pointsMeasurements("Lmes")) Data.pointsMeasurements.Remove("Lmes") sortedMeasurments.Add("Wmes", Data.pointsMeasurements("Wmes")) Data.pointsMeasurements.Remove("Wmes") For i = 2 To numOfMes - 1 Dim mesName As String = Data.pointsMeasurements.Keys(0) Dim lowestValue As Double = 100000 For j = 0 To Data.pointsMeasurements.Count - 1 Dim measureName As String = Data.pointsMeasurements.Keys(j) Dim measureDist As Double If measureName.Split("_")(0) = "MS" Then If Data.pointsMeasurements(measureName)(2) = 1 OrElse Data.pointsMeasurements(measureName)(2) = 3 Then Dim x1 As Double = Data.gratingMiddlePoints.Rows(Data.pointsMeasurements(measureName)(0) - 1)("X") Dim x2 As Double = Data.gratingMiddlePoints.Rows(Data.pointsMeasurements(measureName)(1) - 1)("X") measureDist = Math.Abs(x1 - x2) Else Dim y1 As Double = Data.gratingMiddlePoints.Rows(Data.pointsMeasurements(measureName)(0) - 1)("Y") Dim y2 As Double = Data.gratingMiddlePoints.Rows(Data.pointsMeasurements(measureName)(1) - 1)("Y") measureDist = Math.Abs(y1 - y2) End If ElseIf measureName.Split("_")(0) = "MS1" Then If Data.pointsMeasurements(measureName)(2) = 1 OrElse Data.pointsMeasurements(measureName)(2) = 3 Then Dim x1 As Double = Data.gratingPoints.Rows(Data.pointsMeasurements(measureName)(0) - 1)("X") Dim x2 As Double = Data.gratingMiddlePoints.Rows(Data.pointsMeasurements(measureName)(1) - 1)("X") measureDist = Math.Abs(x1 - x2) Else Dim y1 As Double = Data.gratingPoints.Rows(Data.pointsMeasurements(measureName)(0) - 1)("Y") Dim y2 As Double = Data.gratingMiddlePoints.Rows(Data.pointsMeasurements(measureName)(1) - 1)("Y") measureDist = Math.Abs(y1 - y2) End If Else If Data.pointsMeasurements(measureName)(2) = 1 OrElse Data.pointsMeasurements(measureName)(2) = 3 Then Dim x1 As Double = Data.gratingPoints.Rows(Data.pointsMeasurements(measureName)(0) - 1)("X") Dim x2 As Double = Data.gratingPoints.Rows(Data.pointsMeasurements(measureName)(1) - 1)("X") measureDist = Math.Abs(x1 - x2) Else Dim y1 As Double = Data.gratingPoints.Rows(Data.pointsMeasurements(measureName)(0) - 1)("Y") Dim y2 As Double = Data.gratingPoints.Rows(Data.pointsMeasurements(measureName)(1) - 1)("Y") measureDist = Math.Abs(y1 - y2) End If End If If measureDist < lowestValue Then lowestValue = measureDist mesName = measureName End If Next sortedMeasurments.Add(mesName, Data.pointsMeasurements(mesName)) Data.pointsMeasurements.Remove(mesName) Next Dim OutLine = myView.GetOutline Dim X_Mid = (OutLine(2) - OutLine(0)) / 2 + OutLine(0) Dim Y_Mid = (OutLine(3) - OutLine(1)) / 2 + OutLine(1) Dim scaleDecimal As Double = viewScale1 / viewScale2 For i = 2 To sortedMeasurments.Count - 1 Dim mesName As String = sortedMeasurments.Keys(i) Add_Dimensions(sortedMeasurments(mesName), CompName, myView, iDrawing, swExtensions, OutLine, scaleDecimal, X_Mid, Y_Mid, mesName) Next Add_Dimensions(sortedMeasurments("Lmes"), CompName, myView, iDrawing, swExtensions, OutLine, scaleDecimal, X_Mid, Y_Mid, "Lmes") Add_Dimensions(sortedMeasurments("Wmes"), CompName, myView, iDrawing, swExtensions, OutLine, scaleDecimal, X_Mid, Y_Mid, "Wmes") Dim myView2 As View myView2 = iDrawing.CreateDrawViewFromModelView3(Settings.folderPaths("object_" & Data.objectNum & "_models3D_gratings_sw_support") & "\simplified_grating.SLDPRT", "*Bottom", swSheetWidth / 2, OutLine(3) + sideCounter(0) * 0.01 + 0.03, 0) myView2.UseSheetScale() = True Dim OutLine2 = myView2.GetOutline Dim point1Name As String = "Front Plane@" & CompName & "@" & myView2.GetName2 Dim point2Name As String = "Plane1@" & CompName & "@" & myView2.GetName2 iDrawing.ClearSelection2(True) Dim measurement As IDisplayDimension swExtensions.SelectByID2(point1Name, "PLANE", 0, 0, 0, True, 0, Nothing, 0) swExtensions.SelectByID2(point2Name, "PLANE", 0, 0, 0, True, 0, Nothing, 0) measurement = iDrawing.AddVerticalDimension2(OutLine2(2) + 0.005, OutLine2(1), 0) iDrawing.ClearSelection2(True) measurement.SetUnits2(False, 0, 1, 0, True, 12) measurement.CenterText = True measurement.SetPrecision3(0, 0, 0, 0) Dim longstatus As Integer Dim newName As String newName = Settings.folderPaths("object_" & Data.objectNum & "_drawings_gratings_sw") & "\grating_drawing.SLDDRW" status = layMgr.AddLayer("Symbol", "", 0, 0, 2) status = layMgr.SetCurrentLayer("Symbol") Dim swSkMgr As SketchManager swSkMgr = iDrawing.SketchManager longstatus = iDrawing.ActivateView("Drawing View1") Dim skSegment As Object swSkMgr.AddToDB = True Dim sheetScale = myView.ScaleDecimal For i = 0 To Draw_Grating.DirSymbolPoints.Count - 2 Dim x1, x2, y1, y2 As Double x1 = CDbl(CInt(Draw_Grating.DirSymbolPoints(i)(0) - Data.guiPanelMidX) / (3000 * sheetScale)) y1 = -CDbl(CInt(Draw_Grating.DirSymbolPoints(i)(1) - Data.guiPanelMidY) / (3000 * sheetScale)) x2 = CDbl(CInt(Draw_Grating.DirSymbolPoints(i + 1)(0) - Data.guiPanelMidX) / (3000 * sheetScale)) y2 = -CDbl(CInt(Draw_Grating.DirSymbolPoints(i + 1)(1) - Data.guiPanelMidY) / (3000 * sheetScale)) skSegment = swSkMgr.CreateLine(x1, y1, 0, x2, y2, 0) Next swSkMgr.AddToDB = False longstatus = iDrawing.SaveAs3(newName, 0, 0) longstatus = iDrawing.SaveAs3(Settings.folderPaths("object_" & Data.objectNum & "_drawings_gratings_pdf") & "\grating_drawing.pdf", 0, 2) End Sub Private Shared Sub Add_Dimensions(points() As Integer, CompName As String, myView As View, iDrawing As DrawingDoc, swExtensions As SldWorks.ModelDocExtension _ , OutLine() As Double, scaleDecimal As Double, X_Mid As Double, Y_Mid As Double, mesName As String) Dim measurement As IDisplayDimension Dim point1NameSW, point2NameSW As String If mesName.Split("_")(0) = "MS" Then point1NameSW = "Point" & points(0) - (CInt(mesName.Split("_")(1)) - 1) * 4 & "@Sketch" & CInt(mesName.Split("_")(1)) + 1 & "@" & CompName & "@" & myView.GetName2 point2NameSW = "Point" & points(1) - (CInt(mesName.Split("_")(1)) - 1) * 4 & "@Sketch" & CInt(mesName.Split("_")(1)) + 1 & "@" & CompName & "@" & myView.GetName2 ElseIf mesName.Split("_")(0) = "MS1" Then point1NameSW = "Point" & points(0) & "@Sketch1@" & CompName & "@" & myView.GetName2 point2NameSW = "Point" & points(1) - (CInt(mesName.Split("_")(1)) - 1) * 4 & "@Sketch" & CInt(mesName.Split("_")(1)) + 1 & "@" & CompName & "@" & myView.GetName2 Else point1NameSW = "Point" & points(0) & "@Sketch1@" & CompName & "@" & myView.GetName2 point2NameSW = "Point" & points(1) & "@Sketch1@" & CompName & "@" & myView.GetName2 End If iDrawing.ClearSelection2(True) swExtensions.SelectByID2(point1NameSW, "EXTSKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0) swExtensions.SelectByID2(point2NameSW, "EXTSKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0) Dim mesOffset = 0.01 If points(2) = 1 OrElse points(2) = 3 Then Dim point1, point2 As Double If mesName.Split("_")(0) = "MS" Then point1 = Data.gratingMiddlePoints.Rows(points(0) - 1)("X") point2 = Data.gratingMiddlePoints.Rows(points(1) - 1)("X") ElseIf mesName.Split("_")(0) = "MS1" Then point1 = Data.gratingPoints.Rows(points(0) - 1)("X") point2 = Data.gratingMiddlePoints.Rows(points(1) - 1)("X") Else point1 = Data.gratingPoints.Rows(points(0) - 1)("X") point2 = Data.gratingPoints.Rows(points(1) - 1)("X") End If Dim xPos As Double If Math.Abs(point1) > Math.Abs(point2) Then xPos = point2 + (point1 - point2) / 2 Else xPos = point1 + (point2 - point1) / 2 End If If points(2) = 1 Then measurement = iDrawing.AddHorizontalDimension2(X_Mid + xPos * scaleDecimal, OutLine(3) + 0.005 + mesOffset * sideCounter(0), 0) Else measurement = iDrawing.AddHorizontalDimension2(X_Mid + xPos * scaleDecimal, OutLine(1) - 0.005 - mesOffset * sideCounter(2), 0) End If Else Dim point1, point2 As Double If mesName.Split("_")(0) = "MS" Then point1 = Data.gratingMiddlePoints.Rows(points(0) - 1)("Y") point2 = Data.gratingMiddlePoints.Rows(points(1) - 1)("Y") ElseIf mesName.Split("_")(0) = "MS1" Then point1 = Data.gratingPoints.Rows(points(0) - 1)("Y") point2 = Data.gratingMiddlePoints.Rows(points(1) - 1)("Y") Else point1 = Data.gratingPoints.Rows(points(0) - 1)("Y") point2 = Data.gratingPoints.Rows(points(1) - 1)("Y") End If Dim yPos As Double If Math.Abs(point1) > Math.Abs(point2) Then yPos = point2 + (point1 - point2) / 2 Else yPos = point1 + (point2 - point1) / 2 End If If points(2) = 2 Then measurement = iDrawing.AddVerticalDimension2(OutLine(2) + 0.005 + mesOffset * sideCounter(1), Y_Mid + yPos * scaleDecimal, 0) Else measurement = iDrawing.AddVerticalDimension2(OutLine(0) - 0.005 - mesOffset * sideCounter(3), Y_Mid + yPos * scaleDecimal, 0) End If End If sideCounter(points(2) - 1) = sideCounter(points(2) - 1) + 1 iDrawing.ClearSelection2(True) measurement.SetUnits2(False, 0, 1, 0, True, 12) measurement.CenterText = True measurement.SetPrecision3(0, 0, 0, 0) End Sub End Class