В попытки написать макрос который наглядно показывает как устанавливаются размеры, столкнулся что с угловыми размера всё ни так уж просто. Ставятся они между двух линий в основном, но вариантов может быть несколько.
Чтобы определить в каком месте нужно поставить размер, необходимо указать координаты этого места. В целом на этом все проблемы и заканчиваются, далее код который определят угол между дву линями по их Имени. Правой кнопкой мыши на линию и мы увидим её Имя.
Код у нас состоит из небольшого куска кода и дополнительной функции CoordinateAngleDim("Линия1", "Линия2", 0) в которую мы передаём название двух линий и угол. Угол, имеет 4 значения 0 - меньший угол между линиями, 180 -противоположный, 90 и 270 по бокам соответственно. макрос работает с двумя линями из одной точки, если линии находятся отдалённо друг от друга или пересекаются, то его надо дорабатывать. Но я хочу показать именно принцип.
Несколько слов о команде swApp.SetUserPreferenceToggle swInputDimValOnCreate, False. Эта функция включает или выключает открытие окна для редактирования после нанесения размера. Если она включена то необходимо ручками редактировать размер или подтверждать его. По этому при написании макросов я её отключаю а при ручном проектирование чаще включаю. Вот тут включается через меню:
А ещё в процессе написания это макроса я познакомился с таким понятие как "Мировые координаты"
Есть координаты в 2D эскизе, это всегда оси X и Y а внизу окна у нас есть 3D координаты которые относятся к пространству модели.
В координатах точки на эскизе у нас Y = 17 а в Мировых Y = 0, а Z=-17, в зависимости от плоскости эскизе их взаимоотношение меняется. Так вот когда мы указываем координаты где нам нужно поставить размер нам нужны Мировые координат, а в процессе работы с эскизом мы везде получаем координаты эскиза. Функция GetModelCoordinates как раз переводит одни в другие.
В конце основного кода есть функции swDispDim.ExplementaryAngle, swDispDim.VerticallyOppositeAngle, они тоже отвечают за ориентацию размера, для понимания их работы надо их раскомментировать и посмотреть куда переносится размер.
Для удобства чтения кода, рекомендую его отформатировать используя GPT Chat, он добавит везде необходимые отступы после чего код станет намного нагляднее и после этого его вставить в среду разработки. К сожалению тут нет возможности выложить код в более читабельном виде с возможностью скопировать.
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swFeature As SldWorks.Feature
Dim swDispDim As SldWorks.DisplayDimension
Dim errors As Long
Dim warnings As Long
Dim status As Boolean
Dim swSketch As SldWorks.Sketch
Dim swParam As SldWorks.Dimension
Dim swSketchMgr As SldWorks.SketchManager
Dim BoolStatus As Boolean
Dim swMoDocExt As SldWorks.ModelDocExtension
Dim swSketchSegment As SldWorks.SketchSegment
Dim swLine As SldWorks.SketchLine
Dim startPoint1 As SldWorks.SketchPoint
Dim endPoint1 As SldWorks.SketchPoint
Dim startPoint2 As SldWorks.SketchPoint
Dim endPoint2 As SldWorks.SketchPoint
Dim swSketchPoint As SketchPoint
Dim swPlane As SldWorks.RefPlane
Dim swRefEntity As SldWorks.Entity
Dim swMathUtils As SldWorks.MathUtility
Dim swMathPt As SldWorks.mathPoint
Dim swTransform As SldWorks.MathTransform
Dim swMathTrans As SldWorks.MathTransform
Sub main()
' Подключаемся к SolidWorks
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
' Проверяем, является ли документ деталью
If swModel Is Nothing Or swModel.GetType <> swDocPART Then
MsgBox "Откройте деталь в SolidWorks"
Exit Sub
End If
' Отключаем автоматическое отображение окна ввода размеров при создании
swApp.SetUserPreferenceToggle swInputDimValOnCreate, False
' Получаем активный эскиз
Set swSketchMgr = swModel.SketchManager
Set swSketch = swSketchMgr.ActiveSketch
Set swSelMgr = swModel.SelectionManager
Set swMoDocExt = swModel.Extension
If swSketch Is Nothing Then
MsgBox "Активный эскиз не найден!", vbExclamation
Exit Sub
End If
Set swPlane = swSketch.GetReferenceEntity(swSelectType_e.swSelDATUMPLANES)
' Получаем математические утилиты
Set swMathUtils = swApp.GetMathUtility
Dim ArrCorAngl As Variant
Dim worldCoords As Variant
ArrCorAngl = CoordinateAngleDim("Линия1", "Линия2", 0)
' Получаем мировые координаты
worldCoords = GetModelCoordinates(swApp, swSketch, ArrCorAngl)
' Выводим результат
Debug.Print "Координаты в системе эскиза:" & vbCrLf & _
"X = " & ArrCorAngl(0) & vbCrLf & _
"Y = " & ArrCorAngl(1) & vbCrLf & _
"Z = 0" & vbCrLf & vbCrLf & _
"Мировые координаты:" & vbCrLf & _
"X = " & Round(worldCoords(0), 6) & vbCrLf & _
"Y = " & Round(worldCoords(1), 6) & vbCrLf & _
"Z = " & Round(worldCoords(2), 6), _
vbInformation, "Преобразование координат"
BoolStatus = swModel.Extension.SelectByID2("Линия1", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)
BoolStatus = swModel.Extension.SelectByID2("Линия2", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)
Set swDispDim = swModel.AddDimension2(worldCoords(0), worldCoords(1), worldCoords(2))
' Переносит размер на внешнюю сторону
' swDispDim.ExplementaryAngle
' Переносит размер на противоположный
' swDispDim.VerticallyOppositeAngle
End Sub
Function CoordinateAngleDim(Line1 As String, Line2 As String, PlasDim As Integer) As Variant
' Функция возвращает координаты точки установки размера
' В зависимости от параметра PlasDim, его значения могут быть:
' 0 - размер внутри угла
' 180 - С противоположной стороны
' 90 и 270 - смещённый на 90 градусов
' Входные данные две переменных с объектом Линия
' Возвращает массив с координатами (X,Y,Z=0)
' Проверяем что градус корректно
If Not (PlasDim = 0 Or PlasDim = 180 Or PlasDim = 90 Or PlasDim = 270) Then
CoordinateAngleDim = Nothing
Exit Function
End If
Dim ArryP(3, 2) As Double
' Очистка выделения
swModel.ClearSelection2 True
BoolStatus = swModel.Extension.SelectByID2(Line1, "SKETCHSEGMENT", 0, 0, 0, False, 0, Nothing, 0)
If swSelMgr.GetSelectedObjectType3(1, -1) = swSelSKETCHSEGS Then
Set swSketchSegment = swSelMgr.GetSelectedObject6(1, -1)
' Проверяем, является ли сегмент объектом линии
If swSketchSegment.GetType() = swSketchLINE Then
' Преобразуем SketchSegment в SketchLine
Set swLine = swSketchSegment
Set startPoint1 = swLine.GetStartPoint2()
Set endPoint1 = swLine.GetEndPoint2()
ArryP(0, 0) = startPoint1.X
ArryP(0, 1) = startPoint1.Y
ArryP(0, 2) = startPoint1.Z
ArryP(1, 0) = endPoint1.X
ArryP(1, 1) = endPoint1.Y
ArryP(1, 2) = endPoint1.Z
Else
CoordinateAngleDim = Nothing
Exit Function
End If
End If
BoolStatus = swModel.Extension.SelectByID2(Line2, "SKETCHSEGMENT", 0, 0, 0, False, 0, Nothing, 0)
' Проверяем, выбрана ли линия
If swSelMgr.GetSelectedObjectType3(1, -1) = swSelSKETCHSEGS Then
' Получаем выбранный объект как SketchSegment
Set swSketchSegment = swSelMgr.GetSelectedObject6(1, -1)
' Проверяем, является ли сегмент объектом линии
If swSketchSegment.GetType() = swSketchLINE Then
' Преобразуем SketchSegment в SketchLine
Set swLine = swSketchSegment
Set startPoint2 = swLine.GetStartPoint2()
Set endPoint2 = swLine.GetEndPoint2()
ArryP(2, 0) = startPoint2.X
ArryP(2, 1) = startPoint2.Y
ArryP(2, 2) = startPoint2.Z
ArryP(3, 0) = endPoint2.X
ArryP(3, 1) = endPoint2.Y
ArryP(3, 2) = endPoint2.Z
Else
CoordinateAngleDim = Nothing
Exit Function
End If
End If
' Определяем координаты точки пересечения и конечные точки
Dim ArrFin(1, 2) As Double
Dim ArrPer(0, 2) As Double
Dim k As Integer, g As Integer, f As Integer
f = 0
For k = 0 To 3
For g = 0 To 3
If Not k = g Then
If ArryP(k, 0) = ArryP(g, 0) And _
ArryP(k, 1) = ArryP(g, 1) And _
ArryP(k, 2) = ArryP(g, 2) Then
ArrPer(0, 0) = ArryP(g, 0)
ArrPer(0, 1) = ArryP(g, 1)
ArrPer(0, 2) = ArryP(g, 2)
GoTo Krug
End If
End If
Next
ArrFin(f, 0) = ArryP(k, 0)
ArrFin(f, 1) = ArryP(k, 1)
ArrFin(f, 2) = ArryP(k, 2)
f = f + 1
Krug:
Next
Dim StartPointX As Double: StartPointX = ArrPer(0, 0)
Dim StartPointY As Double: StartPointY = ArrPer(0, 1)
Dim endPoint1X As Double: endPoint1X = ArrFin(0, 0)
Dim endPoint2X As Double: endPoint2X = ArrFin(1, 0)
Dim endPoint1Y As Double: endPoint1Y = ArrFin(0, 1)
Dim endPoint2Y As Double: endPoint2Y = ArrFin(1, 1)
Dim length1 As Double
Dim length2 As Double
Dim lengthUp As Double
Dim angleRad1Y As Double
Dim angleDeg1 As Double
Dim angleDeg2 As Double
Const PI As Double = 3.14
Dim endX As Double
Dim endY As Double
Dim angleDegrees As Double
Dim angleRadians As Double
length1 = Sqr((endPoint1X - StartPointX) ^ 2 + (endPoint1Y - StartPointY) ^ 2)
length2 = Sqr((endPoint2X - StartPointX) ^ 2 + (endPoint2Y - StartPointY) ^ 2)
' Определяем какая длинее
If length1 > length2 Then
lengthUp = length1
Else
lengthUp = length2
End If
' Вычисление угла в радианах относительно оси Y если положительно _
то правее оси если отрицательное то левее
angleRad1Y = WorksheetFunction.Atan2(endPoint1Y - StartPointY, endPoint1X - StartPointX)
' Преобразование угла в градусы
angleDeg1 = angleRad1Y * (180 / PI)
Dim angleRad2Y As Double
angleRad2Y = WorksheetFunction.Atan2(endPoint2Y - StartPointY, endPoint2X - StartPointX)
' Преобразование угла в градусы
angleDeg2 = angleRad2Y * (180 / PI)
' Размер внутри, между линиями
Dim AngleIn As Double ' размер угла (внутри между линиями)
Dim AngleDim As Double ' угол точки, которая делит угол пополам
'Определяем в каком секторе (один из четырех) находятся линии
If angleDeg1 <= 0 And angleDeg1 > -90 _
And angleDeg2 <= 0 And angleDeg2 > -90 Then
GoTo Sect11
ElseIf angleDeg1 <= 0 And angleDeg1 > -90 _
And angleDeg2 <= -90 And angleDeg2 > -180 _
Or angleDeg2 <= 0 And angleDeg2 > -90 _
And angleDeg1 <= -90 And angleDeg1 > -180 Then
GoTo Sect12
ElseIf angleDeg1 <= 0 And angleDeg1 > -90 _
And angleDeg2 >= 90 And angleDeg2 < 180 _
Or angleDeg2 <= 0 And angleDeg2 > -90 _
And angleDeg1 >= 90 And angleDeg1 < 180 Then
GoTo Sect13
ElseIf angleDeg1 <= 0 And angleDeg1 > -90 _
And angleDeg2 >= 0 And angleDeg2 < 90 _
Or angleDeg2 <= 0 And angleDeg2 > -90 _
And angleDeg1 >= 0 And angleDeg1 < 90 Then
GoTo Sect14
ElseIf angleDeg1 <= -90 And angleDeg1 > -180 _
And angleDeg2 <= -90 And angleDeg2 > -180 _
Or angleDeg2 <= -90 And angleDeg2 > -180 _
And angleDeg1 <= -90 And angleDeg1 > -180 Then
GoTo Sect22
ElseIf angleDeg1 <= -90 And angleDeg1 > -180 _
And angleDeg2 >= 90 And angleDeg2 < 180 _
Or angleDeg2 <= -90 And angleDeg2 > -180 _
And angleDeg1 >= 90 And angleDeg1 < 180 Then
GoTo Sect23
ElseIf angleDeg1 <= -90 And angleDeg1 > -180 _
And angleDeg2 >= 0 And angleDeg2 < 90 _
Or angleDeg2 <= -90 And angleDeg2 > -180 _
And angleDeg1 >= 0 And angleDeg1 < 90 Then
GoTo Sect24
ElseIf angleDeg1 >= 90 And angleDeg1 < 180 _
And angleDeg2 >= 90 And angleDeg2 < 180 Then
GoTo Sect33
ElseIf angleDeg1 >= 0 And angleDeg1 < 90 _
And angleDeg2 >= 90 And angleDeg2 < 180 _
Or angleDeg2 >= 0 And angleDeg2 < 90 _
And angleDeg1 >= 90 And angleDeg1 < 180 Then
GoTo Sect34
ElseIf angleDeg1 >= 0 And angleDeg1 < 90 _
And angleDeg2 >= 0 And angleDeg2 < 90 Then
GoTo Sect44
End If
Debug.Print "Другой сектор"
Sect11:
Sect12:
Sect22:
If Abs(angleDeg1) > Abs(angleDeg2) Then
AngleIn = Abs(angleDeg1) - Abs(angleDeg2)
AngleDim = Abs(angleDeg2) + (AngleIn / 2)
Else
AngleIn = Abs(angleDeg2) - Abs(angleDeg1)
AngleDim = Abs(angleDeg1) + (AngleIn / 2)
End If
angleDegrees = AngleDim + 90
GoTo SetP
Sect13:
If Abs(angleDeg1) + Abs(angleDeg2) >= 180 Then
If Abs(angleDeg1) > Abs(angleDeg2) Then
AngleIn = (360 - angleDeg1) - Abs(angleDeg2)
AngleDim = Abs(angleDeg2) + (AngleIn / 2)
Else
AngleIn = (360 - angleDeg2) - Abs(angleDeg1)
AngleDim = Abs(angleDeg1) + (AngleIn / 2)
End If
angleDegrees = AngleDim + 90
Else
If Abs(angleDeg1) > Abs(angleDeg2) Then
AngleIn = Abs(angleDeg1) + Abs(angleDeg2)
AngleDim = (AngleIn / 2) - (angleDeg1 - 90)
Else
AngleIn = Abs(angleDeg2) + Abs(angleDeg1)
AngleDim = (AngleIn / 2) - (angleDeg2 - 90)
End If
angleDegrees = Abs(AngleDim)
End If
GoTo SetP
Sect14:
If angleDeg2 > 0 Then
If Abs(angleDeg1) > Abs(angleDeg2) Then
AngleIn = Abs(angleDeg1) + Abs(angleDeg2)
AngleDim = Abs(angleDeg1) - (AngleIn / 2)
angleDegrees = Abs(AngleDim) + 90
Else
AngleIn = Abs(angleDeg2) + Abs(angleDeg1)
AngleDim = AngleIn / 2
angleDegrees = Abs(AngleDim) + (90 - Abs(angleDeg2))
End If
Else
If Abs(angleDeg1) < Abs(angleDeg2) Then
AngleIn = Abs(angleDeg1) + Abs(angleDeg2)
AngleDim = Abs(angleDeg1) - (AngleIn / 2)
angleDegrees = Abs(AngleDim) + 90
Else
AngleIn = Abs(angleDeg2) + Abs(angleDeg1)
AngleDim = AngleIn / 2
angleDegrees = Abs(AngleDim) + (90 - Abs(angleDeg1))
End If
End If
GoTo SetP
Sect23:
If angleDeg2 < 0 And Abs(angleDeg2) >= Abs(angleDeg1) _
Or angleDeg1 < 0 And Abs(angleDeg1) >= Abs(angleDeg2) Then
If Abs(angleDeg1) > Abs(angleDeg2) Then
AngleIn = (180 - Abs(angleDeg2)) + (180 - Abs(angleDeg1))
AngleDim = 180 - (Abs(angleDeg2) + (AngleIn / 2))
Else
AngleIn = (180 - Abs(angleDeg2)) + (180 - Abs(angleDeg1))
AngleDim = 180 - (Abs(angleDeg1) + (AngleIn / 2))
End If
angleDegrees = AngleDim + 270
Else
If Abs(angleDeg1) > Abs(angleDeg2) Then
AngleIn = (180 - Abs(angleDeg2)) + (180 - Abs(angleDeg1))
AngleDim = 90 + (Abs(angleDeg2) + (AngleIn / 2))
Else
AngleIn = (180 - Abs(angleDeg2)) + (180 - Abs(angleDeg1))
AngleDim = 90 + (Abs(angleDeg1) + (AngleIn / 2))
End If
angleDegrees = Abs(AngleDim)
End If
GoTo SetP
Sect24:
' If angleDeg2 < 0 And Abs(angleDeg2) <= Abs(angleDeg1) _
' Or angleDeg1 < 0 And Abs(angleDeg1) <= Abs(angleDeg2) Then
If Abs(angleDeg1) + Abs(angleDeg2) >= 180 Then
If Abs(angleDeg1) > Abs(angleDeg2) Then
AngleIn = (180 - Abs(angleDeg2)) + (180 - Abs(angleDeg1))
AngleDim = ((Abs(angleDeg1) + (AngleIn / 2))) + 90
Else
AngleIn = (180 - Abs(angleDeg2)) + (180 - Abs(angleDeg1))
AngleDim = ((Abs(angleDeg2) + (AngleIn / 2))) + 90
End If
angleDegrees = AngleDim
Else
If Abs(angleDeg1) > Abs(angleDeg2) Then
AngleIn = Abs(angleDeg1) + Abs(angleDeg2)
AngleDim = 90 + (Abs(angleDeg1) - (AngleIn / 2))
Else
AngleIn = Abs(angleDeg1) + Abs(angleDeg2)
AngleDim = 90 + (Abs(angleDeg2) - (AngleIn / 2))
End If
angleDegrees = Abs(AngleDim)
End If
GoTo SetP
Sect33:
If Abs(angleDeg1) > Abs(angleDeg2) Then
AngleIn = Abs(angleDeg1) - Abs(angleDeg2)
AngleDim = (360 - Abs(angleDeg1)) + (AngleIn / 2)
Else
AngleIn = Abs(angleDeg2) - Abs(angleDeg1)
AngleDim = (360 - Abs(angleDeg2)) + (AngleIn / 2)
End If
angleDegrees = AngleDim + 90
GoTo SetP
Sect34:
If (90 - angleDeg1) > (angleDeg2 - 90) Then
If Abs(angleDeg1) > Abs(angleDeg2) Then
AngleIn = Abs(angleDeg1) - Abs(angleDeg2)
AngleDim = 90 - (Abs(angleDeg2) + (AngleIn / 2))
Else
AngleIn = Abs(angleDeg2) - Abs(angleDeg1)
AngleDim = 90 - (Abs(angleDeg1) + (AngleIn / 2))
End If
angleDegrees = AngleDim
Else
If Abs(angleDeg1) > Abs(angleDeg2) Then
AngleIn = Abs(angleDeg1) - Abs(angleDeg2)
AngleDim = (180 - Abs(angleDeg1)) + (AngleIn / 2)
Else
AngleIn = Abs(angleDeg2) - Abs(angleDeg1)
AngleDim = (180 - Abs(angleDeg2)) + (AngleIn / 2)
End If
angleDegrees = AngleDim + 270
End If
GoTo SetP
Sect44:
If Abs(angleDeg1) > Abs(angleDeg2) Then
AngleIn = Abs(angleDeg1) - Abs(angleDeg2)
AngleDim = (90 - Abs(angleDeg1)) + (AngleIn / 2)
Else
AngleIn = Abs(angleDeg2) - Abs(angleDeg1)
AngleDim = (90 - Abs(angleDeg2)) + (AngleIn / 2)
End If
angleDegrees = AngleDim
GoTo SetP
'****************************************
SetP:
' Перевод угла в радианы
angleRadians = angleDegrees * (PI / 180)
' Вычисление координат конечной точки (Угол относительно оси X)
endX = StartPointX + lengthUp * Cos(angleRadians)
endY = StartPointY + lengthUp * Sin(angleRadians)
' Set swSketchPoint = swSketchMgr.CreatePoint(endX, endY, 0)
' Очистка выделения
swModel.ClearSelection2 True
Dim ArrReturn(2) As Double
ArrReturn(0) = endX
ArrReturn(1) = endY
ArrReturn(2) = 0
CoordinateAngleDim = ArrReturn
End Function
Public Function GetModelCoordinates(swApp As SldWorks.SldWorks, swSketch As SldWorks.Sketch, vPtArr As Variant) As Variant
' Функция преобразует координаты эскиза в мировые координаты
Dim swMathPt As SldWorks.mathPoint
Dim swMathUtil As SldWorks.MathUtility
Dim swMathTrans As SldWorks.MathTransform
Set swMathUtil = swApp.GetMathUtility
Set swMathPt = swMathUtil.CreatePoint(vPtArr)
' Is a unit transform if 3D sketch; for example, selected sketch
' point is automatically in model space
Set swMathTrans = swSketch.ModelToSketchTransform
Set swMathTrans = swMathTrans.Inverse
Set swMathPt = swMathPt.MultiplyTransform(swMathTrans)
GetModelCoordinates = swMathPt.ArrayData
End Function
Возможно, есть более простой способ ставить угловые размеры в желаем месте, поделитесь.