X2021/Wardrobe/SolidWorks/Frame_Drawing.vb

203 lines
9.9 KiB
VB.net

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