Макрос для экспорта данных о деталях

[johnny.mk 3]

Здравствуйте. Подскажите пожалуйста, есть ли возможность написания макроса, который бы экспортировал данные о деталях сборки в excel-файл? К примеру: моменты инерции, массы, координаты центров масс.

Если такое всё же существует, был бы рад глянуть на пример и источники, с которых можно черпать информацию данного рода. Благодарю)

[Kelny 1 239]

13 часа назад, johnny.mk сказал:

есть ли возможность написания макроса, который бы экспортировал данные о деталях сборки в excel-файл? К примеру: моменты инерции, массы, координаты центров масс.

Можете написать макрос.

Если этими данными заполнены свойства деталей, то можно просто создать таблицу спецификации с добавлением столбцов с необходимыми вам свойствами.

[VOleg 228]

Макрос сохраняет свойства файла (не все, а которые я захотел) в экселе...

Sub prop2xls()
 Dim swModel As ModelDoc2
 Dim mde As SldWorks.ModelDocExtension
 Dim swConfigMgr As SldWorks.ConfigurationManager
 Dim swConfig As SldWorks.Configuration
 Dim swCustPropMgr As SldWorks.CustomPropertyManager
 Dim cpm As CustomPropertyManager
 Dim strName() As String
 Dim strValue() As String
 Dim strResValue() As String
 Dim i As Integer
 Dim strTemp1 As String, strTemp2 As String
 Dim vNames As Variant
 Dim xls As Object
 Dim wbs As Excel.Workbooks
 Dim wbk As Excel.Workbook
 Dim wsh As Excel.Worksheet
 Dim rng As Range
 
 Set swApp = Application.SldWorks
 Set swModel = swApp.ActiveDoc

 ' Начальные проверки
 If swModel Is Nothing Then
     MsgBox "Ничего не открыто", , "Откройте сборку или деталь"
     Exit Sub
 End If
 If swModel.GetType <> swDocASSEMBLY And swModel.GetType <> swDocPART Then
     MsgBox "Текущий документ д.б. сборкой или деталью!", , "Откройте сборку или деталь"
     Exit Sub
 End If

 Set mde = swModel.Extension
 Set cpm = mde.CustomPropertyManager("")

 ReDim strName(cpm.Count + 2) As String
 ReDim strValue(cpm.Count + 2) As String
 ReDim strResValue(cpm.Count + 2) As String

 ' обозначение и наименование из текущей конфигурации
 Set swConfigMgr = swModel.ConfigurationManager
 Set swConfig = swConfigMgr.ActiveConfiguration
 Set swCustPropMgr = swConfig.CustomPropertyManager
 strName(0) = "": strName(1) = ""
 vNames = swCustPropMgr.GetNames
 For i = 0 To swCustPropMgr.Count - 1
   swCustPropMgr.Get2 vNames(i), strTemp1, strTemp2
   If UCase(vNames(i)) = "ОБОЗНАЧЕНИЕ" Then
     strName(0) = vNames(i)
     strValue(0) = strTemp1
     strResValue(0) = strTemp2
   End If
   If UCase(vNames(i)) = "НАИМЕНОВАНИЕ" Then
     strName(1) = vNames(i)
     strValue(1) = strTemp1
     strResValue(1) = strTemp2
   End If
 Next i

 ' запоминание имён и значений свойств из средней вкладки в массивы и вывод массивов в Excel
 vNames = cpm.GetNames
 If IsEmpty(vNames) = False Then
    For i = 0 To UBound(vNames)
    cpm.Get3 vNames(i), True, strValue(i + 2), strResValue(i + 2)
    strName(i + 2) = vNames(i)
    Next i
    On Error Resume Next
    i = 0
    Set xls = GetObject(, "Excel.Application")
    If Err Then
      Err.Clear
      Set xls = CreateObject("Excel.Application")
      If Err Then
        Err.Clear
        On Error GoTo 0
        MsgBox "Не могу запустить Excel"
        Exit Sub
      End If
    'Else
      'i = 1
    End If
    On Error GoTo 0
    xls.Visible = True
    'If i = 1 Then
      'Set wbk = xls.ActiveWorkbook
    'Else
      Set wbs = xls.Workbooks
      Set wbk = wbs.Add
    'End If
    With wbk.Worksheets(1)
       For i = 0 To UBound(vNames) + 2
           .Cells(i + 1, 1).Value = strName(i) 'add 1 because row 0 doesn't exist
           .Cells(i + 1, 2).Value = strValue(i)
           .Cells(i + 1, 3).Value = strResValue(i)
       Next i
    End With
    Set rng = wbk.Worksheets(1).UsedRange
    rng.Columns.AutoFit
    Set xls = Nothing
    Set wbs = Nothing
    Set wbk = Nothing
 End If
End Sub

[Kir95 950]

Перед запуском макроса нужно ещё библиотеку подключить в VBA Tools->Reference-

Microsoft Excel XX.0 Type Library (ХХ-версия Эксель)

 

[Maik812 290]

В 02.04.2019 в 21:57, johnny.mk сказал:

есть ли возможность написания макроса, который бы экспортировал данные о деталях сборки в excel-файл? К примеру: моменты инерции, массы, координаты центров масс.

Если такое всё же существует, был бы рад глянуть на пример и источники, с которых можно черпать информацию данного рода.

Если нужно работать с обьемами файлов Solidworks, то Вам нужно сделать так чтоб записывались данные  моменты инерции и др. Прописываете в файле как пользовательские поля.

А вообще еще бывает потребность сортировать по ним (на фотках по материалу) и с именем файла.

Есть вариант оригинальный Total commander Solidworks.wdx . Может Вам просто и достаточно смотреть сразу их или сортировать без файла, ну если фаил то в Excel вставляете из буфера. Вывод данных плагином Solidworks.wdx и потом командой cm_CopyFileDetailsToClip копируете содержимое выведенных данных плагинов. Это универсальный вариант, для любых файлов.

Koмпас и др . тоже самое , главное плагин WDX, а еще если нужно изысканы вещи по данным ну например на каждый фаил данные в отдельный готовый и автоматически, то

http://wincmd.ru/plugring/WdxInfopacker.html

 

Плагин под Solidworks 2014 и ниже.

Вот бы кто сделал бы выше :)

 

Изменено 3 апреля 2019 пользователем Maik812