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)
swExtensions.SelectByID2(point1Name, "EXTSKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)
swExtensions.SelectByID2(point2Name, "EXTSKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)
If i = 1 Then
dimension = iDrawing.AddDimension2(X_Mid, OutLine(3), 0)
Else
dimension = iDrawing.AddDimension2(OutLine(2), Y_Mid, 0)
End If
dimension = iDrawing.adddimension2(X_Mid, OutLine(1), 0)
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