Added drawing dimensions to SW

This commit is contained in:
Anton 2021-02-02 16:33:01 +01:00
parent d68c64aaaa
commit cc6c3c9ac2
2 changed files with 23 additions and 12 deletions

View File

@ -519,7 +519,7 @@ Public Class GUI
pointTable = Create_PointTable()
Program.Export_SW(pointTable, 0.025) 'Make variable ref to Height
Program.Create_Drawing()
End Sub
End Class

View File

@ -106,6 +106,7 @@ Public Class Program
newName = "C:\Users\Anton\Documents\Exjobb\Temp" & "\TESTPART" & 1 & ".SLDPRT"
longstatus = iPart.SaveAs3(newName, 0, 0)
Model.ClearSelection2(True)
Create_Drawing(iPart)
End Sub
@ -133,27 +134,37 @@ Public Class Program
Dim myView As View
myView = iDrawing.CreateDrawViewFromModelView3("C:\Users\Anton\Documents\Exjobb\Temp\TESTPART1.SLDPRT", "*Front", swSheetWidth / 2, swSheetHeight / 2, 0)
Dim swExtensions = iModel.Extension
Dim swExtensions As SldWorks.ModelDocExtension
swExtensions = iDrawing.Extension
Dim RootComp = myView.RootDrawingComponent
Dim CompName = RootComp.Name
Dim dimension As SldWorks.IDisplayDimension
Dim dimension As IDisplayDimension
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 point1Name As String = "Point1@Sketch1@TESTPART1.SLDPRT"
Dim point2Name As String = "Point2@Sketch1@TESTPART1.SLDPRT"
For i = 1 To 2
Dim point1Name As String = "Point" & i & "@Sketch1@" & CompName & "@" & myView.GetName2
Dim point2Name As String = "Point" & i + 1 & "@Sketch1@" & CompName & "@" & myView.GetName2
swExtensions.SelectByID2(point1Name, "POINT", 0, 0, 0, True, 0, Nothing, 0)
swExtensions.SelectByID2(point2Name, "POINT", 0, 0, 0, True, 0, Nothing, 0)
iDrawing.ClearSelection2(True)
dimension = iDrawing.adddimension2(X_Mid, OutLine(1), 0)
swExtensions.SelectByID2(point1Name, "EXTSKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)
swExtensions.SelectByID2(point2Name, "EXTSKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)
iDrawing.ClearSelection2(True)
dimension.SetUnits2(False, 0, 1, 0, True, 12)
dimension.CenterText = True
dimension.SetPrecision3(0, 0, 0, 0)
If i = 1 Then
dimension = iDrawing.AddDimension2(X_Mid, OutLine(3), 0)
Else
dimension = iDrawing.AddDimension2(OutLine(2), Y_Mid, 0)
End If
iDrawing.ClearSelection2(True)
dimension.SetUnits2(False, 0, 1, 0, True, 12)
dimension.CenterText = True
dimension.SetPrecision3(0, 0, 0, 0)
Next
Dim longstatus As Integer
Dim newName As String