Imports SldWorks Public Class Frame_Drawing Private Shared frameComponents Public Shared Sub Create_Assemblies(frameInSimplified As Boolean) Dim swApp As SldWorks.SldWorks swApp = CType(System.Runtime.InteropServices.Marshal.GetActiveObject("SldWorks.Application"), SldWorks.SldWorks) Dim model As ModelDoc2 Dim assembly As IAssemblyDoc Dim longstatus As Integer For i = 0 To Frame_3D.cuttingList.Count - 1 model = swApp.NewDocument("C:\ProgramData\SolidWorks\SOLIDWORKS 2020\templates\Assembly.asmdot", 0, 0, 0) assembly = model Dim endPieceLength As Integer = 2000 For j = 0 To Frame_3D.cuttingList.ElementAt(i).Value.Count - 1 endPieceLength -= Frame_3D.sideFrameLengths("Frame " & Frame_3D.cuttingList.ElementAt(i).Value(j)) Next Dim numOfParts As Integer = 0 Dim endPieceExist As Integer = 0 If endPieceLength > 0 Then numOfParts = Frame_3D.cuttingList.ElementAt(i).Value.Count Else numOfParts = Frame_3D.cuttingList.ElementAt(i).Value.Count - 1 endPieceExist = 1 End If Dim compNames(numOfParts) As String Dim coordNames(numOfParts) As String Dim transMatrix As Object = Nothing For j = 0 To compNames.Count - 2 + endPieceExist Dim frameID = Frame_3D.cuttingList.ElementAt(i).Value(j) compNames(j) = Settings.folderPaths("object_" & Data.objectNum & "_models3D_frames_sw") & "\" & "FRAME_L_STRAIGHT_" & frameID & ".SLDPRT" coordNames(j) = "" Next If endPieceLength > 0 Then compNames(compNames.Count - 1) = Settings.folderPaths("object_" & Data.objectNum & "_models3D_frames_sw_support") & "\FRAME_L_END_PIECE" & i + 1 & ".SLDPRT" coordNames(coordNames.Count - 1) = "" End If Dim assemComps As Object assemComps = assembly.AddComponents3((compNames), (transMatrix), (coordNames)) Dim config As Configuration config = assembly.GetActiveConfiguration Dim swCustPropMgr = config.CustomPropertyManager longstatus = swCustPropMgr.Add3("Benämning", 30, "Whole L Straight Frame " & Individual.ComboBox_Frame.Text & " x 3", 1) longstatus = swCustPropMgr.Add3("ExtraBenämning1", 30, "Cutting Instructions for Whole Frame ", 1) longstatus = swCustPropMgr.Add3("Materialsort", 30, "Hot Dip Galvanized Steel", 1) longstatus = swCustPropMgr.Add3("Art. Nr", 30, "TBD", 1) longstatus = swCustPropMgr.Add3("Material_Art", 30, "TBD", 1) longstatus = swCustPropMgr.Add3("Author", 30, "", 1) longstatus = swCustPropMgr.Add3("Ändrad av", 30, "", 1) longstatus = swCustPropMgr.Add3("SkapadDatum", 30, "", 1) longstatus = swCustPropMgr.Add3("RevideradDatum", 30, "", 1) longstatus = swCustPropMgr.Add3("ExtraBenämning2", 30, "", 1) longstatus = swCustPropMgr.Add3("epdmid", 30, "", 1) longstatus = swCustPropMgr.Add3("Revision", 30, "", 1) longstatus = model.SaveAs3(Settings.folderPaths("object_" & Data.objectNum & "_models3D_frames_sw") & "\FRAME_ASSEMBLY" & i + 1 & ".SLDASM", 0, 0) swApp.CloseDoc(Settings.folderPaths("object_" & Data.objectNum & "_models3D_frames_sw") & "\FRAME_ASSEMBLY" & i + 1 & ".SLDASM") Next End Sub Public Shared Sub Generate_Drawings() Dim swApp As SldWorks.SldWorks swApp = CType(System.Runtime.InteropServices.Marshal.GetActiveObject("SldWorks.Application"), SldWorks.SldWorks) Dim status As Boolean 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) swSheet.SetScale(1, 10, False, False) swSheet.SetName("Frame 1") Dim layMgr As LayerMgr layMgr = iDrawing.GetLayerManager() For i = 0 To Frame_3D.cuttingList.Count - 1 If i > 0 Then status = iDrawing.NewSheet3("Frame" & i + 1, 12, 12, 1, 10, False, Settings.HLCtFolder & "\Files Needed\A3 Part.slddrt", swSheetWidth, swSheetHeight, "Same as sheet specified in Document Properties") End If status = layMgr.SetCurrentLayer("Svenska") Dim myView As View myView = iDrawing.CreateDrawViewFromModelView3(Settings.folderPaths("object_" & Data.objectNum & "_models3D_frames_sw") & "\FRAME_ASSEMBLY" & i + 1 & ".SLDASM", "*Front", swSheetWidth / 2, swSheetHeight / 2, 0) myView.UseSheetScale() = True myView.SetDisplayTangentEdges2(2) Dim swExtensions As SldWorks.ModelDocExtension swExtensions = iDrawing.Extension Dim RootComp = myView.RootDrawingComponent Dim CompName = RootComp.Name Dim OutLine = myView.GetOutline Dim components = RootComp.GetChildren() For j = 0 To components.Length - 1 Dim frameComponentName As String If j = Frame_3D.cuttingList.ElementAt(i).Value.Count Then frameComponentName = "FRAME_L_END_PIECE" & i + 1 Else frameComponentName = "FRAME_L_STRAIGHT_" & Frame_3D.cuttingList.ElementAt(i).Value(j) End If Dim plane1Name As String = "OffPlane1@" & CompName & "@" & myView.GetName2 & "/" & frameComponentName & "-1@" & CompName.Split("-")(0) Dim plane2Name As String = "OffPlane2@" & CompName & "@" & myView.GetName2 & "/" & frameComponentName & "-1@" & CompName.Split("-")(0) Dim xOffset As Double = 0 For k = 0 To j If k = Frame_3D.cuttingList.ElementAt(i).Value.Count Then xOffset += (2000 / 10 - xOffset) / 2 ElseIf k = j Then xOffset += (Frame_3D.sideFrameLengths("Frame " & Frame_3D.cuttingList.ElementAt(i).Value(k)) / 10) / 2 Else xOffset += Frame_3D.sideFrameLengths("Frame " & Frame_3D.cuttingList.ElementAt(i).Value(k)) / 10 End If Next xOffset = xOffset / 1000 Dim X_Mid = OutLine(2) - 0.005 - xOffset iDrawing.ClearSelection2(True) Dim measurement As IDisplayDimension status = swExtensions.SelectByID2(plane1Name, "PLANE", 0, 0, 0, False, 0, Nothing, 0) status = swExtensions.SelectByID2(plane2Name, "PLANE", 0, 0, 0, True, 0, Nothing, 0) measurement = iDrawing.AddHorizontalDimension2(X_Mid, OutLine(3) + 0.005, 0) iDrawing.ClearSelection2(True) measurement.SetUnits2(False, 0, 1, 0, True, 12) measurement.CenterText = True measurement.SetPrecision3(0, 0, 0, 0) 'Balloon Dim balloonStyle As Integer Dim balloonOffset As Double Dim balloonText As String If j < Frame_3D.cuttingList.ElementAt(i).Value.Count Then balloonStyle = 1 balloonOffset = 0.01 balloonText = "F-" & Frame_3D.cuttingList.ElementAt(i).Value(j) Else balloonStyle = 0 balloonOffset = -0.03 balloonText = "Obsolete" End If Dim worldX As Double = swSheetWidth / 2 + ((2000 / 2) / 10) / 1000 - xOffset status = swExtensions.SelectByRay(worldX, 0.153, 0, 0, 0, -1, 0.0005, 2, False, 0, 0) Dim BomBalloonParams As Object BomBalloonParams = swExtensions.CreateBalloonOptions() BomBalloonParams.Style = balloonStyle BomBalloonParams.Size = 3 BomBalloonParams.UpperTextContent = 1 BomBalloonParams.UpperText = """" BomBalloonParams.ShowQuantity = False BomBalloonParams.QuantityPlacement = 1 BomBalloonParams.QuantityDenotationText = "X" BomBalloonParams.QuantityOverride = False Dim myNote = swExtensions.InsertBOMBalloon2(BomBalloonParams) Dim noteAnnotation As IAnnotation noteAnnotation = myNote.GetAnnotation() noteAnnotation.SetPosition2(worldX + balloonOffset, 0.13, 0) Dim textFormat = noteAnnotation.GetTextFormat(0) textFormat.CharHeight = 0.0025 status = noteAnnotation.SetTextFormat(0, False, textFormat) iDrawing.ClearSelection2(True) Dim balloonName As String = myNote.GetName() status = swExtensions.SelectByID2(balloonName & "@Drawing View" & i + 1, "NOTE", 0, 0, 0, False, 0, Nothing, 0) Dim editedNote = swExtensions.EditBalloonProperties2(balloonStyle, 3, 0, balloonText, 0, "", 0, False, 1, "X", 0.001) Next Next Dim newName As String newName = Settings.folderPaths("object_" & Data.objectNum & "_drawings_frames_sw") & "\frame_drawing.SLDDRW" status = iDrawing.SaveAs3(newName, 0, 0) status = iDrawing.SaveAs3(Settings.folderPaths("object_" & Data.objectNum & "_drawings_frames_pdf") & "\frame_drawing.pdf", 0, 2) End Sub End Class