Блоки, вставка и Excel

[Smiti]

Здравствуйте. Подскажите а как сделать так чтобы блок не вставлялся новый а изменялись параметры существующего согласно значениям ячеек из эксель? хочу сделать такую программу которая из существующего блока в открытом двг файле делала бы дхф файлы по параметрам из дхф и сохраняла их под именем из соответствующей ячейки.

[Алексей Кулик]

Тему отделил. Кстати, настоятельно советую дать теме другое название, более информативное и понятное.
А по сути вопроса вообще ничего не понял - что есть в начале и что должно получиться в конце.

[Smiti]

в начале есть файл двг, который содержит динамический блок. и есть спецификация в эксель с данными по параметрам блока и их маркировкой. надо из этого блока сделать дхф файлы по параметрам из спецификации эксель. один файл дхф это одна позиция из спецификации. название дхф файла из ячеек первого столбца(№п/п).

[Алексей Кулик]

Самое простое что приходит в голову - это использовать команду _.-wblock (кажется, там есть возможность сохранять в dxf-формат. Но я в этом не уверен).

[Smiti]

насобирал  в просторах интернета. алгоритм сохраняет дхф файл  с названием из эксель и соответствующими параметрами. не могу понять как сделать чтобы он выдавал весь список из эксель.
и еще один момент который не могу решить, это как сделать так чтобы программа не вставляла новый блок а редактировала параметры существующего.

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

1. Sub InsertBlock()
2.     Dim blockRef As AcadBlockReference
3.     Dim blockname As String
4.     Dim dxf_name As String
5.     Dim props As Variant
6.     Dim Index As Variant
7.     Dim prop As Variant
8.     Dim Path As String
9.     Dim CellValue As String
10.     Dim FinalFileName As String
11.     Dim basePnt(0 To 2) As Double
12.     Dim x As Variant
13.     Dim y As Variant
14.     Dim z As Variant
15.     Dim objCollection As Object, docpath, dxfname
16.     Dim ent As AcadEntity, ent2 As AcadEntity
17.     Dim sp As New AcadSecurityParams
18.     Dim AP As Excel.Application
19.     Dim WB As Excel.Workbook
20.     Dim WS As Excel.Worksheet
21.    
22.  
23.     'в случае ошибки переходим к следующему действию
24.        
25.     On Error Resume Next
26.  
27.     'Подключаемся к Excel
28.    
29.     Set AP = Excel.Application
30.     Set WB = AP.Workbooks.Open("d:\Spec.xlsx")
31.     Set WS = WB.Worksheets("Лист1")
32.    
33.     'вставка блока
34.    blockname = "ФК"
35.     x = 0: y = 0: z = 0
36.     basePnt(0) = x: basePnt(1) = y: basePnt(2) = z
37.     'вставка блока
38.    Set blockRef = ThisDrawing.ModelSpace.InsertBlock(basePnt, blockname, 1, 1, 1, 0)
39.      
40.     'получение динамических свойств блока
41.    
42.     If blockRef.IsDynamicBlock = True Then
43.         props = blockRef.GetDynamicBlockProperties
44.             For Index = LBound(props) To UBound(props)
45.                 Set prop = props(Index)
46.                     If prop.PropertyName = "Высота" Then
47.                         prop.Value = Cells(4, 2) * 1
48.                     ElseIf prop.PropertyName = "Длина" Then
49.                         prop.Value = Cells(4, 3) * 1
50.                     End If
51.             Next
52.     End If
53.    Path = "d:\"
54.    CellValue = Cells(4, 1)
55.    FinalFileName = Path & CellValue
56.    ThisDrawing.SaveAs FinalFileName, ac2007_dxf
57.  
58. End Sub

[Алексей Кулик]

Ну чисто теоретически можно попробовать найти - опять же на просторах - код поиска последней занятой ячейки в Excel. Ну и ставить счетчик от 0 (хотя, может, и с 1 - не помню) и до последней занятой строчки.
Советую не забыть после записи очищать файл от всего мусора.

[TiDi]

Есть такая фича в acad (конкретно в Express Tools), называется ATTIN и ATTOUT.
Первая позволяет загрузить атрибуты в блоки, вторая - наоборот, выгрузить в txt файл.
Настоятельно рекомендую изучить этот метод.

[Алексей Кулик]

TiDi, так это про атрибуты. А нужны свойства. Это во-первых.
Во-вторых, нужен не просто текстовый файл, а dxf.
То есть attin/attout и их аналоги (которые, кстати, и я когда-то рисовал) помогут тут слабо.

[TiDi]

Тогда я бы просто предложил взять за основу dxf файл с указанным блоком.
Код скопировать в Excel на отдельный лист.
Создать столько копий листа, сколько необходимо по спецификации.
Найти строчки кода, которые отвечают за тот или иной параметр и просто сделать ссылку на соответствующую ячейку в спецификации для каждого листа.
Полученное на листах остается только скопировать в блокнот и переименовать.
Открыть файлы и убедиться, что блоки в них соответствуют параметрам из спецификации.

[Smiti]

Создать столько копий листа, сколько необходимо по спецификации

спецификации бывают и по 500  и более позиций. создавать столько копий кода и в каждую вставлять ссылку на ячейку это будет еще дольше чем просто редактировать в дхф блоки и пересохранять с требуемым именем

[TiDi]

Ну если вы собрались это делать вручную...
Я же вам написал алгоритм, который нужно осуществить.
Он довольно просто трансформируется в VBA код.

[Smiti]

Я же вам написал алгоритм, который нужно осуществить.

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

[TiDi]

Скопируйте код в excel, где лежит ваша спецификация и откройте чертеж, где есть определение блока
Не забудьте добавить ссылку на библиотеку AutoCAD

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

1. Sub new_dxf()
2.     Dim blockRef As AcadBlockReference
3.     Dim blockname As String
4.     Dim props As Variant
5.     Dim Index, i As Variant
6.     Dim prop As Variant
7.     Dim Path As String
8.     Dim CellValue As String
9.     Dim FinalFileName As String
10.     Dim basePnt(0 To 2) As Double
11.     Dim x, y, z As Variant
12.  
13.     On Error Resume Next
14.    
15.     Set AC = AutoCAD.Application.ActiveDocument
16.     Set WS = ThisWorkbook.ActiveSheet
17.    
18.     lastrow = ActiveSheet.Cells(1, 1).End(xlDown).Rows + 1
19.    
20.     For i = 2 To lastrow
21.  
22.   'укажите название вашего блока
23.    blockname = "1"
24.     x = 0: y = 0: z = 0
25.     basePnt(0) = x: basePnt(1) = y: basePnt(2) = z
26.    
27.     Set blockRef = AC.ModelSpace.InsertBlock(basePnt, blockname, 1, 1, 1, 0)
28.      
29.     If blockRef.IsDynamicBlock = True Then
30.         props = blockRef.GetDynamicBlockProperties
31.             For Index = LBound(props) To UBound(props)
32.                 Set prop = props(Index)
33.                     If prop.PropertyName = "Длина" Then
34.                         prop.Value = Cells(i, 2) * 1
35.                     ElseIf prop.PropertyName = "Ширина" Then
36.                         prop.Value = Cells(i, 3) * 1
37.                     End If
38.             Next
39.     End If
40.    
41. 'укажите свой путь
42.   Path = "C:\Users\user\Desktop\"
43.    
44.    CellValue = Cells(i, 1)
45.    FinalFileName = Path & CellValue
46.    AC.SaveAs FinalFileName, ac2007_dxf
47.    
48.    Set objss = AC.SelectionSets.Add("ToErase")
49.     objss.Select acSelectionSetAll
50.     objss.Erase
51.     objss.Delete
52.    Next i
53.    
54. End Sub
55.  

[Smiti]

Скопируйте код в excel, где лежит ваша спецификация и откройте чертеж, где есть определение блока
Не забудьте добавить ссылку на библиотеку AutoCAD

Благодарю. после некоторых манипуляций этот код у меня заработал. но возник вопрос: как прописать переменную для названия файла так  чтобы скрипт работал не только с цифровыми значениями но и с буквенными. Если в первом столбце стоят цифры, то все работает. а если ставлю буквы, то ноль реакции.

[TiDi]

Вот эту строчку

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

1. lastrow = ActiveSheet.Cells(1, 1).End(xlDown).Rows + 1

замените на эту:

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

1. lastrow = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown)))

и заработает