Создание нового чертежа dxf

[Anatoly]

Надо из открытого документа dwg взять нужные объекты и сохранить как dxf.
Или сначала создать dxf, а потом скопировать объекты.

[Александр Ривилис]

Document.Export в dxf - но насколько я помню экспортируется все из чертежа. Поэтому лишнее придётся в чертеже предварительно стереть. Ну или забыть про VBA.
Можно еще Document.SaveAs если нужно в формат определённой версии DXF.

[Anatoly]

Если кому-то нужно, то вот.

Код - 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

[Александр Ривилис]

А почему ThisDrawing.SaveAs, а не newDoc.SaveAs? Ты же копируешь сохраняешь полный исходный чертеж.

[Anatoly]

Нет, я копирую только то, что нужно, что предварительно выбрано SelectionSet'ом.
А ThisDrawing это в данный момент новый документ.
Наверное можно и newDoc.

[Александр Ривилис]

Нет, я копирую только то, что нужно, что предварительно выбрано SelectionSet'ом.

Но сохраняешь старый чертеж, а не тот в который копируешь выбранное.

[Anatoly]

Со старым ничего не происходит. Новый документ сохраняется как dxf.

[Anatoly]

Вообще-то в реальном коде я в цикле из исходного dwg делаю разные dxf с разным содержанием.

[Anatoly]

Попробовал newDoc.SaveAs вместо ThisDrawing.SaveAs. Результат тот-же.
Но наверное логичнее newDoc.SaveAs.
Спасибо.

[Александр Ривилис]

Попробовал newDoc.SaveAs вместо ThisDrawing.SaveAs. Результат тот-же.
Но наверное логичнее newDoc.SaveAs.
Спасибо.

Значит у тебя происходит переключение на новый чертеж и он становится ThisDrawing. Не помню как это на VBA работает.

[Anatoly]

Да, так и происходит.
В новом чертеже делаю разные вещи, для которых нужен ThisDrawing, типа

Код - Visual Basic [Выбрать]

1. ThisDrawing.Application.ZoomExtents
2. ThisDrawing.PurgeAll
3.  

Поэтому и написал ThisDrawing.SaveAs