Вставка блока в Автокаде по данным из Эксель?

[ValeraVOLS]

Сообщение от doober

Ка ни странно,но для большого количества строк в файле Excel,количество строк кода меньше.

BlockName-это имя блока,а не команда.

Sub InsertBlock()
    Dim Eeex, K, Path As String, lLastRowMY As Long
      Dim BlockName As String
         Dim insertionPnt(0 To 2) As Double
    Path = "E:\777\Задание.xls"
    Set Eeex = GetObject(Path).Worksheets(1)
    lLastRowMY = Eeex.Cells(Eeex.Rows.Count, 1).End(-4162).Row
    K = Eeex.Range("A1:B" & lLastRowMY)
    Eeex.Parent.Close (False)
    For n = 1 To UBound(K)
        BlockName = K(n, 1)
        insertionPnt(0) = CDbl(Split(K(n, 2), ";")(0))
        insertionPnt(1) = CDbl(Split(K(n, 2), ";")(1))
        insertionPnt(2) = 0#
        Set objTemp = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, BlockName, _
                                                         1, 1, 1, 0)
    Next

End Sub

Как всё таки полезно знать тему по составлению макросов. Хотел бы тоже этому научиться. Как вы этого достигли? Может порекомендуете с чего начать?

[ValeraVOLS]

Здравствуйте. Подскажите пожалуйста, как отрисовать "Дугу" в Автокаде между вставленными блоками по коду, который прописан выше? Есть один нюанс, вершины начала и конца "Дуги" отличаются, так как блоки имеют разную конфигурацию. Хотелось бы, чтобы в коде, прописанный выше, была добавлена функция по прорисовке дуги!

[doober]

Построение аналогично построению на кульмане.
Имеем координаты вершин,радиус.находим координаты центра окружности.
расчитываем углы на вершины.строим дугу.Самое важное-правильный расчет углов.

Set arcObj = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngleInRadian, endAngleInRadian)

Как всё таки полезно знать тему по составлению макросов. Хотел бы тоже этому научиться. Как вы этого достигли? Может порекомендуете с чего начать?

Это было очень давно.и непрада.Начало 90-х,паяльник,процессор Z80.машинные коды...
+ремонт и обслуживание вычислиьельных комплексов.

с чего начать?

вам главное полность понимать весь процесс построения объекта на листе ватмана,использовать карандаш и рейсшину.
И аналагично выполнить в коде.
Справку прилагаю.

[ValeraVOLS]

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

[ValeraVOLS]

А вот по коду, который вы предоставили выше для дуги, нельзя ли его привязать к точкам, которые прорисованы в блоках, а радиус сделать каким-нибудь постоянным числом?

[doober]

Точки есть.радиус есть.
Расчитали центр окружности,расчитали углы,построили дугу.
Код писать на это дело времени нет.

[ValeraVOLS]

То есть нужно в вашем коде дописать следующие имена переменных:
Dim arcObj As AcadArc
Dim startAngleInRadian As Double
Dim centerpoint As Double
Dim endAngleInRadian As Double

startAngleInRadian=присвоить точку1 в Блоке 1 (Как сделать чтобы автоматом находилась эта точка?)
centerpoint=присвоить точку2 (Как сделать чтобы автоматом находилась эта точка?)
endAngleInRadian=присвоить точку3 в Блоке 2 (Как сделать чтобы автоматом находилась эта точка?)

Set arcObj = ThisDrawing.ModelSpace.AddArc(cente rPoint, startAngleInRadian, endAngleInRadian)

End Sub

[doober]

startAngleInRadian-Это угол,и он либо расчитывается,либо либо строиться отрезок,и получаем его угол наклона

startAngleInRadian=присвоить точку1 в Блоке 1 (Как сделать чтобы автоматом находилась эта точка?)

Аналогично и для второй точки.
Точка в блоке,если она одна,определяется путем перебора примитивов этого блока.
Если она не одна,то можно создать окружность с радиусом 1.
Центр ее искомая точка.
Центр описываемой окружности расчитывается по формулам из учебника геометрии.

Волоски у Хоттабыча закончились.

PS:Я работаю в 2008.конвертор качать и устанавливать желания нет.
Стоимость макроса с вашим функционалом лежит в пределах 1,5к-2к руб

[ValeraVOLS]

Ну хорошо может быть тогда просто подскажите с помощью какой команды отыскивать примитив в блоке?

[doober]

    Dim P() As Double
    For Each cell In ThisDrawing.ModelSpace
        If cell.ObjectName = "AcDbCircle" Then
            P = cell.Center
        End If
        If cell.ObjectName = "AcDbPoint" Then
            P = cell.Coordinates
        End If
    Next cell