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


Option Explicit

Sub ReplaceMassDotWithCommaInDrawing()

    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    Dim swCustPropMgr As SldWorks.CustomPropertyManager
    Dim massValue As String
    Dim resolvedValue As String
    Dim newMassText As String
    Dim swAnn As SldWorks.Annotation
    Dim swNote As SldWorks.Note
    Dim notes As Variant
    Dim i As Integer
    Dim foundInNote As Boolean
    Dim sheetName As String

    ' --- 1. Получаем текущий чертёж ---
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    If swModel Is Nothing Then
        MsgBox "Откройте документ SolidWorks."
        Exit Sub
    End If
    
    ' Проверяем, что это чертёж
    If swModel.GetType <> swDocDRAWING Then
        MsgBox "Этот макрос работает только на чертеже."
        Exit Sub
    End If
    
    Set swDraw = swModel
    
    ' --- 2. Получаем свойства чертежа ---
    Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")
    
    If swCustPropMgr Is Nothing Then
        MsgBox "Не удалось получить доступ к свойствам чертежа."
        Exit Sub
    End If
    
    ' --- 3. Читаем свойство массы (ищем в пользовательских свойствах чертежа) ---
    swCustPropMgr.Get2 "Масса", massValue, resolvedValue
    
    ' Если свойство Масса не найдено в чертеже, пробуем получить из ссылочной модели
    If resolvedValue = "" Then
        MsgBox "Свойство 'Масса' не найдено в свойствах чертежа." & vbCrLf & _
               "Попытка получить массу из связанной детали..."
        
        ' Получаем первую ссылочную модель (деталь/сборку)
        Dim swRefDoc As SldWorks.ModelDoc2
        Dim refDocName As String
        Dim refDocPath As String
        
        refDocPath = swDraw.GetReferenceModelName(1) ' первая ссылка
        If refDocPath <> "" Then
            Set swRefDoc = swApp.OpenDoc(refDocPath, swDocPART)
            If Not swRefDoc Is Nothing Then
                ' Получаем свойства ссылочной модели
                Dim swRefCustPropMgr As SldWorks.CustomPropertyManager
                Set swRefCustPropMgr = swRefDoc.Extension.CustomPropertyManager("")
                
                If Not swRefCustPropMgr Is Nothing Then
                    swRefCustPropMgr.Get2 "Масса", massValue, resolvedValue
                End If
                
                ' Закрываем ссылочную модель (не сохраняем)
                swApp.CloseDoc refDocPath
            End If
        End If
        
        If resolvedValue = "" Then
            MsgBox "Не удалось найти массу ни в чертеже, ни в связанной детали."
            Exit Sub
        End If
    End If
    
    ' --- 4. Заменяем точку на запятую ---
    newMassText = Replace(resolvedValue, ".", ",")
    
    ' --- 5. Записываем результат в свойство чертежа ---
    swCustPropMgr.Add3 "Масса", swCustomInfoType_e.swCustomInfoText, newMassText, swCustomPropertyAddOption_e.swCustomPropertyAddOption_Overwrite
    
    ' --- 6. Обновляем все заметки на чертеже, содержащие ссылку на массу ---
    Dim swSheet As SldWorks.Sheet
    Dim sheetCount As Integer
    Dim j As Integer
    foundInNote = False
    
    ' Получаем количество листов
    sheetCount = swDraw.GetSheetCount
    
    For j = 1 To sheetCount
        Set swSheet = swDraw.GetSheet(j)
        swDraw.ActivateSheet swSheet.GetName
        
        ' Получаем все заметки на листе
        notes = swSheet.GetNotes
        
        If Not IsEmpty(notes) Then
            For i = 0 To UBound(notes)
                Set swAnn = notes(i)
                ' Проверяем, что это заметка
                If swAnn.Type = swAnnotationType_e.swNote Then
                    Set swNote = swAnn.GetSpecificAnnotation
                    
                    ' Проверяем текст заметки на наличие ссылки на массу
                    Dim noteText As String
                    noteText = swNote.GetText
                    
                    ' Если в заметке есть ссылка на массу (стандартные форматы)
                    If InStr(1, noteText, "$PRP:""Масса""", vbTextCompare) > 0 Or _
                       InStr(1, noteText, "$PRPSHEET:""Масса""", vbTextCompare) > 0 Then
                        ' Обновляем заметку (переустановка текста для обновления ссылки)
                        swNote.SetText noteText
                        foundInNote = True
                    End If
                End If
            Next i
        End If
    Next j
    
    ' Возвращаемся на первый лист
    swDraw.ActivateSheet swDraw.GetSheet(1).GetName
    
    ' --- 7. Обновляем модель ---
    swModel.ForceRebuild3 False
    
    ' --- 8. Выводим сообщение ---
    Dim msg As String
    msg = "Готово! Масса обновлена, теперь она равна: " & newMassText & " кг"
    If foundInNote Then
        msg = msg & vbCrLf & "Заметки с ссылкой на массу обновлены."
    Else
        msg = msg & vbCrLf & "Нет заметок, содержащих ссылку на массу."
    End If
    MsgBox msg

End Sub