[AutoCAD] Построение линии по координатам из Эксель

@Babidjon · Регистрация: 28.03.2023

Студворк — интернет-сервис помощи студентам

Работаю на VBA совсем недавно, пишу программу для автокада, которая берёт координаты их эксель и делает построения точек в чертеже. Рядом с точками так же отображается текст. Пытаюсь сделать так чтобы все точки соединялись линией, но выдаёт ошибку "Run-time-error '-2145320943 (80210011)': Слишком мало элементов в SafeArray, или общее число элементов не кратно трем. Код массивов в принципе не содержит... Точки и текст строит как нужно

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
With Лист1
Do While Worksheets("Лист1").Cells(R + 1, 1).Value <> ""
If Worksheets("Лист1").Cells.Cells(R + 1, 1).Value = "" Then
Exit Do
End If
StPt(0) = Worksheets("Лист1").Cells(R, 2).Value
StPt(1) = Worksheets("Лист1").Cells(R, 3).Value
StPt(2) = Worksheets("Лист1").Cells(R, 4).Value
textString = Worksheets("Лист1").Cells(R, 1).Value
 
Set objText = ThisDrawing.ModelSpace.AddText(textString, StPt, TextHeight)
Set pointObj = ThisDrawing.ModelSpace.AddPoint(StPt)
 
'Соединяющая линия
 
  Dim objEnt As AcadLWPolyline
  If CheckBox1 = True Then
  Set objEnt = ThisDrawing.ModelSpace.AddLightWeightPolyline(StPt)
  objEnt.Closed = True
  End If

Добавлено через 2 часа 5 минут

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
With Лист1
Do While Worksheets("Лист1").Cells(R + 1, 1).Value <> ""
If Worksheets("Лист1").Cells.Cells(R + 1, 1).Value = "" Then
Exit Do
End If
StPt(0) = Worksheets("Лист1").Cells(R, 2).Value
StPt(1) = Worksheets("Лист1").Cells(R, 3).Value
StPt(2) = Worksheets("Лист1").Cells(R, 4).Value
textString = Worksheets("Лист1").Cells(R, 1).Value
 
Set objText = ThisDrawing.ModelSpace.AddText(textString, StPt, TextHeight)
Set pointObj = ThisDrawing.ModelSpace.AddPoint(StPt)
 
'Соединяющая линия
 
  Dim objEnt As AcadLWPolyline
  If CheckBox1 = True Then
  Set objEnt = ThisDrawing.ModelSpace.AddLightWeightPolyline(StPt)
  objEnt.Closed = True
  End If

SergioJek · 28.03.2023, 09:46

Babidjon, макрос полностью можете показать?
Где и как объявлен StPt ?

@Babidjon · 28.03.2023, 09:57 **[ТС]**

Таким образом, далее идёт код который отправлял ранее

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub CommandButton1_Click()
 
Dim AP As Excel.Application
Dim WB As Excel.Workbook
Dim WS As Excel.Worksheet
Dim LastRow As Long
 
Set AP = Excel.Application
fldr = InputBox("Укажите адрес файла")
Excel.Workbooks.Open Filename:=fldr
Set WB = AP.Workbooks.Open(fldr)
Set WS = WB.Worksheets("Лист1")
 
Dim pointObj As AcadPoint
Dim StPt(0 To 2) As Double
Dim StPtt(3) As String
Dim R As Integer
R = 2

SergioJek · 28.03.2023, 10:02

Babidjon, AddLightWeightPolyline строится по 2D-точкам.
Как её построить из одной 3D точки я не знаю. Автокад тоже растерялся.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Example_AddLightWeightPolyline()
    ' This example creates a lightweight polyline in model space.
    
    Dim plineObj As AcadLWPolyline
    Dim points(0 To 9) As Double
    
    ' Define the 2D polyline points
    points(0) = 1: points(1) = 1
    points(2) = 1: points(3) = 2
    points(4) = 2: points(5) = 2
    points(6) = 3: points(7) = 2
    points(8) = 4: points(9) = 4
        
    ' Create a lightweight Polyline object in model space
    Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
    ZoomAll
    
End Sub

@Babidjon · 28.03.2023, 10:11 **[ТС]**

Это понял, не подскажите что использовать для построения по 3-м точкам из документа? Уже 6 часов бьюсь головой по столу...

SergioJek · 28.03.2023, 10:20

Visual Basic
1
2
3
4
5
6
7
8
9
Dim StPt(0 To 5) As Double
StPt(0)=x1
StPt(1)=y1
StPt(2)=x2
StPt(3)=y2
StPt(4)=x3
StPt(5)=y3
Set objEnt = ThisDrawing.ModelSpace.AddLightWeightPolyline(StPt)
objEnt.Closed = True

Xi и Yi ищите на листе Excel, мне отсюда не видно...

@Babidjon · 28.03.2023, 10:35 **[ТС]**

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

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub Example_AddLightWeightPolyline()
 
    Dim AP As Excel.Application
Dim WB As Excel.Workbook
Dim WS As Excel.Worksheet
Dim LastRow As Long
 
Set AP = Excel.Application
fldr = InputBox("Укажите адрес файла")
Excel.Workbooks.Open Filename:=fldr
Set WB = AP.Workbooks.Open(fldr)
Set WS = WB.Worksheets("Лист1")
    
 
    Dim plineObj As AcadPolyline
    Dim StPt(0 To 5) As Double
Dim R As Integer
R = 2
   
   With Лист1
Do While Worksheets("Лист1").Cells(R + 1, 1).Value <> ""
If Worksheets("Лист1").Cells.Cells(R + 1, 1).Value = "" Then
Exit Do
End If
StPt(0) = Worksheets("Лист1").Cells(R, 2).Value
StPt(1) = Worksheets("Лист1").Cells(R, 2).Value
StPt(2) = Worksheets("Лист1").Cells(R, 3).Value
StPt(3) = Worksheets("Лист1").Cells(R, 3).Value
StPt(4) = Worksheets("Лист1").Cells(R, 4).Value
StPt(5) = Worksheets("Лист1").Cells(R, 4).Value
 
 
    Set plineObj = ThisDrawing.ModelSpace.AddPolyline(StPt)
    ZoomAll
    
    R = R + 1
 
Loop
End With
End Sub

SergioJek · 28.03.2023, 14:17

Нету у меня автокада, домыслил как сумел

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim StPt() As Double
Dim R As Integer
R = 2
   
With Лист1
  Do While .Cells(R + 1, 1).Value <> ""
    reDIM PRESERVE StPt(0TO R*2-3)
    StPt(R*2-4) = .Cells(R, 2).Value
    StPt(R*2-3) = .Cells(R, 3).Value
    R = R + 1
  Loop
  Set plineObj = ThisDrawing.ModelSpace.AddPolyline(StPt)
  ZoomAll
END WITH

@Dinoxromniy · 28.03.2023, 15:16

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

Пытаюсь сделать так чтобы все точки соединялись линией

у вас z координата у всех точек разная, полилиния так не умеет, она плоская. Либо соединять каждые две точки отдельными полилиниями из двух точек, которые будут начерчены в наклонных плоскостях, либо использовать 3d полилинию.
Попробуйте код ниже, нужно только заменить путь к вашему файла экселя:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub Example_Add3DPoly()
Dim xlApp  As Excel.Application
Dim i As Long
Set xlApp = Excel.Application
Set docXl = xlApp.Workbooks.Open("d:\Downloads\dem.xlsx")
 
 
 
    
    Dim polyObj As Acad3DPolyline
    Dim points() As Double
    ReDim points(0 To (docXl.Worksheets.Item("Лист1").Cells(2, 2).End(xlDown).Row - 1) * 3 - 1) As Double
  
    For i = LBound(points) To docXl.Worksheets.Item("Лист1").Cells(2, 2).End(xlDown).Row - 2
    points(i * 3) = docXl.Worksheets.Item("Лист1").Cells(2 + i, 2).value
    points(i * 3 + 1) = docXl.Worksheets.Item("Лист1").Cells(2 + i, 3).value
    points(i * 3 + 2) = docXl.Worksheets.Item("Лист1").Cells(2 + i, 4).value
 
    Next i
   
    Set polyObj = ThisDrawing.ModelSpace.Add3DPoly(points)
    ZoomAll
    Set polyObj = Nothing
    Set xlApp = Nothing
    Set docXl = Nothing
End Sub

@Babidjon · 28.03.2023, 15:43 **[ТС]**

Спасибо, спасли

@Dinoxromniy · 28.03.2023, 15:46

Babidjon, подобные задачи на самом деле не требуют программирования, иногда быстрее сгенерировать команду прямо в командную строку. Есть хорошая книга "Язык макрокоманд", автор Свет, правда, очень фундаментальная, но иногда - незаменимая.

Новые блоги и статьи Все статьи Все блоги /
Access VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .	Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .
Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .	Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .	Мысли в слух kumehtar 18.11.2025 Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .	Создание Single Page Application на фреймах krapotkin 16.11.2025 Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .	Фото: Daniel Greenwood kumehtar 13.11.2025

SergioJek 428 / 333 / 61 Регистрация: 29.06.2019 Сообщений: 493
	28.03.2023, 09:46
	Babidjon, макрос полностью можете показать? Где и как объявлен StPt ? 0

@Babidjon -14 / 0 / 0 Регистрация: 28.03.2023 Сообщений: 28
	28.03.2023, 10:11 [ТС]
	Это понял, не подскажите что использовать для построения по 3-м точкам из документа? Уже 6 часов бьюсь головой по столу... 0

@Babidjon -14 / 0 / 0 Регистрация: 28.03.2023 Сообщений: 28
	28.03.2023, 15:43 [ТС]
	Спасибо, спасли 0

@Dinoxromniy Динохромный 1636 / 774 / 287 Регистрация: 22.12.2015 Сообщений: 2,411
	28.03.2023, 15:46
	Babidjon, подобные задачи на самом деле не требуют программирования, иногда быстрее сгенерировать команду прямо в командную строку. Есть хорошая книга "Язык макрокоманд", автор Свет, правда, очень фундаментальная, но иногда - незаменимая. 0

[AutoCAD] Построение линии по координатам из Эксель

Решение