Сообщество программистов Autodesk в СНГ

ADN Club => VBA => Тема начата: Anatoly от 17-03-2021, 17:58:15

Название: Создание нового чертежа dxf
Отправлено: Anatoly от 17-03-2021, 17:58:15
Надо из открытого документа dwg взять нужные объекты и сохранить как dxf.
Или сначала создать dxf, а потом скопировать объекты.
Название: Re: Создание нового чертежа dxf
Отправлено: Александр Ривилис от 17-03-2021, 18:02:35
Document.Export в dxf - но насколько я помню экспортируется все из чертежа. Поэтому лишнее придётся в чертеже предварительно стереть. Ну или забыть про VBA.
Можно еще Document.SaveAs если нужно в формат определённой версии DXF.
Название: Re: Создание нового чертежа dxf
Отправлено: Anatoly от 19-03-2021, 23:30:52
Если кому-то нужно, то вот.
Код - Visual Basic [Выбрать]
  1. Sub test()
  2. Dim ent As AcadEntity
  3. Dim sset As AcadSelectionSet
  4. Dim intData() As Integer, varData() As Variant
  5. Dim objCollection() As Object
  6. Dim activeDoc As AcadDocument
  7. '..............................................
  8. 'dxfnam=.....
  9. 'intData
  10. 'varData
  11. '..............................................
  12. Set sset = ThisDrawing.SelectionSets.Add("SS1")
  13. sset.Select acSelectionSetAll, , , intData, varData
  14. If sset.Count = 0 Then Exit Sub
  15.  
  16. Set activeDoc = ThisDrawing.Application.ActiveDocument
  17. docpath = activeDoc.Path
  18.  
  19. ReDim objCollection(0 To sset.Count - 1)
  20. i = 0
  21.  
  22. For Each ent In sset
  23.   Set objCollection(i) = ent
  24.     i = i + 1
  25. Next
  26.  
  27. CopyObjects activeDoc, objCollection, docpath, dxfnam
  28.  
  29. ThisDrawing.SelectionSets.Item("SS1").Delete:    Set sset = Nothing
  30. Exit Sub
  31. End Sub
  32. '######################################################################################
  33. Sub CopyObjects(activeDoc As AcadDocument, objCollection() As Object, docpath, dxfnam)
  34. Dim ent As AcadEntity
  35. Dim newDoc As AcadDocument
  36.  
  37. Set newDoc = Documents.Add    ' Create a new drawing
  38.        
  39. retObjects = activeDoc.CopyObjects(objCollection, newDoc.ModelSpace)
  40.  
  41. ' retObjects что-то делаем со скопированными объектами
  42.  
  43. ThisDrawing.SaveAs docpath & "\" & dxfnam, ac2007_dxf
  44. newDoc.Close
  45. Exit Sub
  46. End Sub
Название: Re: Создание нового чертежа dxf
Отправлено: Александр Ривилис от 19-03-2021, 23:34:34
А почему ThisDrawing.SaveAs, а не newDoc.SaveAs? Ты же копируешь сохраняешь полный исходный чертеж.
Название: Re: Создание нового чертежа dxf
Отправлено: Anatoly от 19-03-2021, 23:43:26
Нет, я копирую только то, что нужно, что предварительно выбрано SelectionSet'ом.
А ThisDrawing это в данный момент новый документ.
Наверное можно и newDoc.
Название: Re: Создание нового чертежа dxf
Отправлено: Александр Ривилис от 19-03-2021, 23:45:35
Нет, я копирую только то, что нужно, что предварительно выбрано SelectionSet'ом.
Но сохраняешь старый чертеж, а не тот в который копируешь выбранное.
Название: Re: Создание нового чертежа dxf
Отправлено: Anatoly от 19-03-2021, 23:46:59
Со старым ничего не происходит. Новый документ сохраняется как dxf.
Название: Re: Создание нового чертежа dxf
Отправлено: Anatoly от 19-03-2021, 23:49:27
Вообще-то в реальном коде я в цикле из исходного dwg делаю разные dxf с разным содержанием.
Название: Re: Создание нового чертежа dxf
Отправлено: Anatoly от 19-03-2021, 23:54:58
Попробовал newDoc.SaveAs вместо ThisDrawing.SaveAs. Результат тот-же.
Но наверное логичнее newDoc.SaveAs.
Спасибо.
Название: Re: Создание нового чертежа dxf
Отправлено: Александр Ривилис от 19-03-2021, 23:58:23
Попробовал newDoc.SaveAs вместо ThisDrawing.SaveAs. Результат тот-же.
Но наверное логичнее newDoc.SaveAs.
Спасибо.
Значит у тебя происходит переключение на новый чертеж и он становится ThisDrawing. Не помню как это на VBA работает.
Название: Re: Создание нового чертежа dxf
Отправлено: Anatoly от 19-03-2021, 23:59:20
Да, так и происходит.
В новом чертеже делаю разные вещи, для которых нужен ThisDrawing, типа
Код - Visual Basic [Выбрать]
  1. ThisDrawing.Application.ZoomExtents
  2. ThisDrawing.PurgeAll
  3.  
Поэтому и написал ThisDrawing.SaveAs