ADN Club > VBA

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

(1/3) > >>

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

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

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

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

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

--- Код - Visual Basic [Выбрать] ---Sub InsertBlock()    Dim blockRef As AcadBlockReference    Dim blockname As String    Dim dxf_name As String    Dim props As Variant    Dim Index As Variant    Dim prop As Variant    Dim Path As String    Dim CellValue As String    Dim FinalFileName As String    Dim basePnt(0 To 2) As Double    Dim x As Variant    Dim y As Variant    Dim z As Variant    Dim objCollection As Object, docpath, dxfname    Dim ent As AcadEntity, ent2 As AcadEntity    Dim sp As New AcadSecurityParams    Dim AP As Excel.Application    Dim WB As Excel.Workbook    Dim WS As Excel.Worksheet         'в случае ошибки переходим к следующему действию            On Error Resume Next     'Подключаемся к Excel        Set AP = Excel.Application    Set WB = AP.Workbooks.Open("d:\Spec.xlsx")    Set WS = WB.Worksheets("Лист1")        'вставка блока    blockname = "ФК"    x = 0: y = 0: z = 0    basePnt(0) = x: basePnt(1) = y: basePnt(2) = z    'вставка блока    Set blockRef = ThisDrawing.ModelSpace.InsertBlock(basePnt, blockname, 1, 1, 1, 0)         'получение динамических свойств блока        If blockRef.IsDynamicBlock = True Then        props = blockRef.GetDynamicBlockProperties            For Index = LBound(props) To UBound(props)                Set prop = props(Index)                    If prop.PropertyName = "Высота" Then                        prop.Value = Cells(4, 2) * 1                    ElseIf prop.PropertyName = "Длина" Then                        prop.Value = Cells(4, 3) * 1                    End If            Next    End If   Path = "d:\"   CellValue = Cells(4, 1)   FinalFileName = Path & CellValue   ThisDrawing.SaveAs FinalFileName, ac2007_dxf End Sub

Навигация

[0] Главная страница сообщений

[#] Следующая страница

Перейти к полной версии