Загрузка данных


Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swSelMgr As SldWorks.SelectionMgr
Dim swEdge As SldWorks.Edge
Dim swCurve As SldWorks.Curve
Dim swCenterMark As SldWorks.CenterMark
Dim dblDiameterMM As Double
Dim vParams As Variant

Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    Set swSelMgr = swModel.SelectionManager
    
    ' 1. Проверяем, что выделено ребро
    If swSelMgr.GetSelectedObjectType3(1, -1) <> 24 Then
        MsgBox "Выделите ребро отверстия"
        Exit Sub
    End If
    
    Set swEdge = swSelMgr.GetSelectedObject6(1, -1)
    Set swCurve = swEdge.GetCurve
    
    ' 2. Проверяем, что это окружность, и получаем диаметр
    If Not swCurve.IsCircle() Then
        MsgBox "Ребро не является окружностью"
        Exit Sub
    End If
    
    vParams = swCurve.CircleParams ' vParams(6) = Radius
    dblDiameterMM = vParams(6) * 2 * 1000 ' Переводим радиус (м) в диаметр (мм)
    
    ' 3. Вставляем центровую метку (обычный крест)
    Set swCenterMark = swDraw.InsertCenterMark3(swCenterMarkStyle_e.swCenterMarkStyle_Cross, False, False)
    
    If swCenterMark Is Nothing Then
        MsgBox "Не удалось вставить центровую метку"
        Exit Sub
    End If
    
    ' 4. Применяем настройки по ГОСТ 2.303-68
    swCenterMark.UseDocDisplaySettings = False ' Используем локальные настройки
    
    If dblDiameterMM < 12 Then
        ' Для отверстий МЕНЬШЕ 12 мм — сплошная тонкая линия
        swCenterMark.CenterLineFont = False
        swCenterMark.Size = 0.003
        swCenterMark.Gap = 0.001
    Else
        ' Для отверстий 12 мм и БОЛЬШЕ — штрихпунктирная линия (осевой шрифт)
        swCenterMark.CenterLineFont = True
        swCenterMark.Size = 0.006
        swCenterMark.Gap = 0.0015
    End If
    
    swCenterMark.ScaleByView = True ' Масштабирование по виду
    swModel.ForceRebuild3 False
    
    MsgBox "Центровая метка вставлена. Диаметр: " & Round(dblDiameterMM, 2) & " мм"
End Sub