Проникающая гидроизоляция бетона
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > .NET > Как соеденить отрезками облако точек и построить изолинии. VB.net

Как соеденить отрезками облако точек и построить изолинии. VB.net

Ответ
Поиск в этой теме
Непрочитано 10.08.2013, 17:33 #1
Как соеденить отрезками облако точек и построить изолинии. VB.net
DEM
 
YngIngKllr
 
СПб
Регистрация: 29.03.2005
Сообщений: 12,793

В общем перехожу потихоньку на VB.net
Возник вопрос по созданию триангуляционной сетки, по существующим точкам...
Можно воспользоваться алгоритмом Delone, но вот как найти ближайшие точки ума не приложу.
Может есть какая то функция в автокаде которая позволяет это сделать..
Точки создаются программно, их расположение не такое регулярное как на представленном чертеже.

Вложения
Тип файла: dwg
DWG 2010
ТОчки.dwg (134.5 Кб, 2138 просмотров)

__________________
Шаг 12й......
Мои публикации
Просмотров: 3519
 
Непрочитано 10.08.2013, 18:22
#2
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Не могу не спросить.
Сейчас практически все программы для работы с геодезическими данными умеют это делать. Почему не воспользоваться уже готовыми?
Do$ вне форума  
 
Автор темы   Непрочитано 10.08.2013, 18:58
#3
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,793


Do$
Дело в том что это надо сделать на чистом автокаде+VB...
Задача в принципе уже ставилась на форуме но в более широком смысле, импорт результатов есть, но надо до делывать то что так и не сделали....
Библиотеки готовые в принципе тоже можно применять....
__________________
Шаг 12й......
Мои публикации
DEM вне форума  
 
Непрочитано 10.08.2013, 19:35
#4
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Кое-что можно найти на форумах / блогах
http://through-the-interface.typepad...=triangulation
http://www.theswamp.org/index.php?to...3462#msg373462
http://www.planetsourcecode.com/vb/s...35722&lngWId=1
но в 3Д я сомневаюсь, чтобы это было четко реализовано и расшарено,
хотя я не спец в этих делах
Олег (jr.) вне форума  
 
Непрочитано 10.08.2013, 20:05
#5
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,075


Цитата:
Сообщение от DEM Посмотреть сообщение
Как соеденить отрезками облако точек и построить изолинии. VB.net
Я так понимаю что ты не оставил идею...
если точки берутся из asf файла, то там есть описание сетки, соответственно построить "облако" легко.
По поводу изолиний, то на странице с кодом, собрано много ссылок на тему изолиний, изучай. Хотя подавляющее большинство реализаций, это метод шагающих квадратов, в википедии есть описание.
__________________
_бложиг
Boxa на форуме  
 
Непрочитано 10.08.2013, 20:34
#6
trir


 
Регистрация: 18.12.2010
Сообщений: 3,524


Скворцов А.В., Триангуляция Делоне и её применение
trir на форуме  
 
Непрочитано 10.08.2013, 21:25
#7
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Тут нужно применить 2 алгоритма сначала
обойти все точки и создать наружный контур через
Convex Hull, затем применить триангуляцию, иначе получится
такой результат:
Вложения
Тип файла: dwg
DWG 2007
TestPoints.dwg (545.7 Кб, 2017 просмотров)
Олег (jr.) вне форума  
 
Автор темы   Непрочитано 10.08.2013, 23:11
#8
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,793


Boxa
Нет не отказался :-)
И даже вижу, что это облегчит работу.
Описание полигонов там есть, но оно не то, сетка не полностью совпадает с точками армирования. Можно конечно комплексный подход сделать.
Олег (jr.)
Контур наружний и даже внутренние есть.
Спасибо за ссылки гляну.
ОООО...
ТО что надо, а какой код ты использовал????
__________________
Шаг 12й......
Мои публикации

Последний раз редактировалось DEM, 11.08.2013 в 06:50.
DEM вне форума  
 
Непрочитано 11.08.2013, 09:27
#9
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Цитата:
Сообщение от DEM Посмотреть сообщение
Boxa
Нет не отказался :-)
И даже вижу, что это облегчит работу.
Описание полигонов там есть, но оно не то, сетка не полностью совпадает с точками армирования. Можно конечно комплексный подход сделать.
Олег (jr.)
Контур наружний и даже внутренние есть.
Спасибо за ссылки гляну.
ОООО...
ТО что надо, а какой код ты использовал????
Ищи в гугле код для классса Triangulate.cs, если не найдешь,
потом скину в личку, автор кажется Gilles Chanteau (gile)
Олег (jr.) вне форума  
 
Автор темы   Непрочитано 11.08.2013, 09:53
#10
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,793


Олег (jr.)
Хммм...
А его можно будет с vb совместить..
Зарегестрировать как отдельный класс, и добавить функции?
Вот еще набрел на вариант...
http://alglib.sources.ru/download.php
Только теперь надо бы разобраться как его использовать.
__________________
Шаг 12й......
Мои публикации

Последний раз редактировалось DEM, 11.08.2013 в 10:33.
DEM вне форума  
 
Непрочитано 11.08.2013, 16:02
#11
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Цитата:
Сообщение от DEM Посмотреть сообщение
Олег (jr.)
Хммм...
А его можно будет с vb совместить..
Зарегестрировать как отдельный класс, и добавить функции?
Вот еще набрел на вариант...
http://alglib.sources.ru/download.php
Только теперь надо бы разобраться как его использовать.
Я для теста просто добавил этот класс в первый попавшийся проект и все дела,
там три команды вроде все 3 работают одинаково, на VB.NET
очень легко переложить
Не проверенная конвертация, доделай сам:

Код:
[Выделить все]
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports System
<Assembly: CommandClass(GetType(TesterCS.Triangulate))>

Namespace TesterVB

	Public Class Triangulate
		Public Function circum(x1 As Double, y1 As Double, x2 As Double, y2 As Double, x3 As Double, y3 As Double, _
			ByRef xc As Double, ByRef yc As Double, ByRef r As Double) As Boolean
			' Calculation of circumscribed circle coordinates and
			' squared radius

			Const  eps As Double = 1E-06
			Const  big As Double = 1000000000000.0
			Dim result As Boolean = True
			Dim m1 As Double, m2 As Double, mx1 As Double, mx2 As Double, my1 As Double, my2 As Double, _
				dx As Double, dy As Double

			If (Math.Abs(y1 - y2) < eps) AndAlso (Math.Abs(y2 - y3) < eps) Then
				result = False
				xc = x1
				yc = y1
				r = big
			Else
				If Math.Abs(y2 - y1) < eps Then
					m2 = -(x3 - x2) / (y3 - y2)
					mx2 = (x2 + x3) / 2
					my2 = (y2 + y3) / 2
					xc = (x2 + x1) / 2
					yc = m2 * (xc - mx2) + my2
				ElseIf Math.Abs(y3 - y2) < eps Then
					m1 = -(x2 - x1) / (y2 - y1)
					mx1 = (x1 + x2) / 2
					my1 = (y1 + y2) / 2
					xc = (x3 + x2) / 2
					yc = m1 * (xc - mx1) + my1
				Else
					m1 = -(x2 - x1) / (y2 - y1)
					m2 = -(x3 - x2) / (y3 - y2)
					If Math.Abs(m1 - m2) < eps Then
						result = False
						xc = x1
						yc = y1
						r = big
					Else
						mx1 = (x1 + x2) / 2
						mx2 = (x2 + x3) / 2
						my1 = (y1 + y2) / 2
						my2 = (y2 + y3) / 2
						xc = (m1 * mx1 - m2 * mx2 + my2 - my1) / (m1 - m2)
						yc = m1 * (xc - mx1) + my1
					End If
				End If
			End If
			dx = x2 - xc
			dy = y2 - yc
			r = dx * dx + dy * dy
			Return result
		End Function

		Private Enum OutputObjectType
			PolyFaceMesh = 1
			Solid3d = 2
			SubDMesh = 4
			All = 7
		End Enum

		Private Sub TriangulatePoints(objType As OutputObjectType, maxpoints As Integer)
			Dim doc As Document = Application.DocumentManager.MdiActiveDocument
			Dim db As Database = doc.Database
			Dim ed As Editor = doc.Editor

			Dim createSubDMesh As Boolean = (objType And OutputObjectType.SubDMesh) > 0
			Dim createPolyFaceMesh As Boolean = (objType And OutputObjectType.PolyFaceMesh) > 0
			Dim createSolid3d As Boolean = (objType And OutputObjectType.Solid3d) > 0

			Dim tvs As TypedValue() = {New TypedValue(0, "POINT")}
			Dim sf As New SelectionFilter(tvs)
			Dim pso As New PromptSelectionOptions()
			pso.MessageForAdding = vbLf & "Select points:"
			pso.AllowDuplicates = False
			Dim psr As PromptSelectionResult = ed.GetSelection(pso, sf)

			If psr.Status = PromptStatus.[Error] Then
				Return
			End If
			If psr.Status = PromptStatus.Cancel Then
				Return
			End If

			Dim ss As SelectionSet = psr.Value
			Dim npts As Integer = ss.Count
			If npts < 3 Then
				ed.WriteMessage("Minimum of 3 points must be selected!")
				Return
			End If
			If npts > maxpoints Then
				ed.WriteMessage("Maximum number of points exceeded!")
				Return
			End If

			Dim zref As Double = 0.0
			If createSolid3d Then
				Dim ps As PromptDoubleResult = ed.GetDouble(vbLf & "Enter Z coordinate of reference plane:")
				If ps.Status <> PromptStatus.OK Then
					Return
				End If
				zref = ps.Value
			End If

			Dim i As Integer, j As Integer, k As Integer, ntri As Integer, ned As Integer, nouted As Integer, _
				status1 As Integer = 0, status2 As Integer = 0
			Dim status As Boolean

			' Point coordinates

			Dim ptx As Double() = New Double(maxpoints + 2) {}
			Dim pty As Double() = New Double(maxpoints + 2) {}
			Dim ptz As Double() = New Double(maxpoints + 2) {}

			' Triangle definitions

			Dim pt1 As Integer() = New Integer(maxpoints * 2) {}
			Dim pt2 As Integer() = New Integer(maxpoints * 2) {}
			Dim pt3 As Integer() = New Integer(maxpoints * 2) {}

			' Circumscribed circle

			Dim cex As Double() = New Double(maxpoints * 2) {}
			Dim cey As Double() = New Double(maxpoints * 2) {}
			Dim rad As Double() = New Double(maxpoints * 2) {}
			Dim xmin As Double, ymin As Double, xmax As Double, ymax As Double, dx As Double, dy As Double, _
				xmid As Double, ymid As Double
			Dim ed1 As Integer() = New Integer(maxpoints * 2) {}
			Dim ed2 As Integer() = New Integer(maxpoints * 2) {}
			Dim outed1 As Integer() = Nothing
			If createSolid3d Then
				outed1 = New Integer(maxpoints) {}
			End If

			Dim idarray As ObjectId() = ss.GetObjectIds()
			Dim tr As Transaction = db.TransactionManager.StartTransaction()
			Using tr
				Dim ent As DBPoint
				k = 0
				For i = 0 To npts - 1
					ent = DirectCast(tr.GetObject(idarray(k), OpenMode.ForRead, False), DBPoint)
					ptx(i) = ent.Position(0)
					pty(i) = ent.Position(1)
					ptz(i) = ent.Position(2)
					For j = 0 To i - 1
						If (ptx(i) = ptx(j)) AndAlso (pty(i) = pty(j)) Then
							i -= 1
							npts -= 1
							status2 += 1
						End If
					Next
					k += 1
				Next
				tr.Commit()
			End Using

			If status2 > 0 Then
				ed.WriteMessage(vbLf & "Ignored {0} point(s) with same coordinates.", status2)
			End If

			' Supertriangle 

			xmin = ptx(0)
			xmax = xmin
			ymin = pty(0)
			ymax = ymin
			For i = 0 To npts - 1
				If ptx(i) < xmin Then
					xmin = ptx(i)
				End If
				If ptx(i) > xmax Then
					xmax = ptx(i)
				End If
				If pty(i) < xmin Then
					ymin = pty(i)
				End If
				If pty(i) > xmin Then
					ymax = pty(i)
				End If
			Next
			dx = xmax - xmin
			dy = ymax - ymin
			xmid = (xmin + xmax) / 2
			ymid = (ymin + ymax) / 2
			i = npts
			ptx(i) = xmid - (90 * (dx + dy)) - 100
			pty(i) = ymid - (50 * (dx + dy)) - 100
			ptz(i) = 0
			pt1(0) = i
			i += 1
			ptx(i) = xmid + (90 * (dx + dy)) + 100
			pty(i) = ymid - (50 * (dx + dy)) - 100
			ptz(i) = 0
			pt2(0) = i
			i += 1
			ptx(i) = xmid
			pty(i) = ymid + 100 * (dx + dy + 1)
			ptz(i) = 0
			pt3(0) = i
			ntri = 1
			circum(ptx(pt1(0)), pty(pt1(0)), ptx(pt2(0)), pty(pt2(0)), ptx(pt3(0)), pty(pt3(0)), _
				cex(0), cey(0), rad(0))

			' Main loop

			For i = 0 To npts - 1
				ned = 0
				xmin = ptx(i)
				ymin = pty(i)
				j = 0
				While j < ntri
					dx = cex(j) - xmin
					dy = cey(j) - ymin
					If ((dx * dx) + (dy * dy)) < rad(j) Then
						ed1(ned) = pt1(j)
						ed2(ned) = pt2(j)
						ned += 1
						ed1(ned) = pt2(j)
						ed2(ned) = pt3(j)
						ned += 1
						ed1(ned) = pt3(j)
						ed2(ned) = pt1(j)
						ned += 1
						ntri -= 1
						pt1(j) = pt1(ntri)
						pt2(j) = pt2(ntri)
						pt3(j) = pt3(ntri)
						cex(j) = cex(ntri)
						cey(j) = cey(ntri)
						rad(j) = rad(ntri)
						j -= 1
					End If
					j += 1
				End While

				For j = 0 To ned - 2
					For k = j + 1 To ned - 1
						If (ed1(j) = ed2(k)) AndAlso (ed2(j) = ed1(k)) Then
							ed1(j) = -1
							ed2(j) = -1
							ed1(k) = -1
							ed2(k) = -1
						End If
					Next
				Next

				For j = 0 To ned - 1
					If (ed1(j) >= 0) AndAlso (ed2(j) >= 0) Then
						pt1(ntri) = ed1(j)
						pt2(ntri) = ed2(j)
						pt3(ntri) = i
						status = circum(ptx(pt1(ntri)), pty(pt1(ntri)), ptx(pt2(ntri)), pty(pt2(ntri)), ptx(pt3(ntri)), pty(pt3(ntri)), _
							cex(ntri), cey(ntri), rad(ntri))
						If Not status Then
							status1 += 1
						End If
						ntri += 1
					End If
				Next
			Next

			' Removal of outer triangles

			i = 0
			nouted = 0
			While i < ntri
				If (pt1(i) >= npts) OrElse (pt2(i) >= npts) OrElse (pt3(i) >= npts) Then
					If createSolid3d Then
						If (pt1(i) >= npts) AndAlso (pt2(i) < npts) AndAlso (pt3(i) < npts) Then
							ed1(nouted) = pt2(i)
							ed2(nouted) = pt3(i)
							nouted += 1
						End If
						If (pt2(i) >= npts) AndAlso (pt1(i) < npts) AndAlso (pt3(i) < npts) Then
							ed1(nouted) = pt3(i)
							ed2(nouted) = pt1(i)
							nouted += 1
						End If
						If (pt3(i) >= npts) AndAlso (pt1(i) < npts) AndAlso (pt2(i) < npts) Then
							ed1(nouted) = pt1(i)
							ed2(nouted) = pt2(i)
							nouted += 1
						End If
					End If
					ntri -= 1
					pt1(i) = pt1(ntri)
					pt2(i) = pt2(ntri)
					pt3(i) = pt3(ntri)
					cex(i) = cex(ntri)
					cey(i) = cey(ntri)
					rad(i) = rad(ntri)
					i -= 1
				End If
				i += 1
			End While

			If createSolid3d Then
				outed1(0) = 0
				For i = 1 To nouted - 1
					For j = 1 To nouted - 1
						If ed2(outed1(i - 1)) = ed1(j) Then
							outed1(i) = j
							j = nouted
						End If
					Next
				Next
				outed1(nouted) = 0
			End If

			tr = db.TransactionManager.StartTransaction()
			Using tr
				Dim bt As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead, False), BlockTable)
				Dim btr As BlockTableRecord = DirectCast(tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite, False), BlockTableRecord)

				If createPolyFaceMesh Then
					Dim pfm As New PolyFaceMesh()
					btr.AppendEntity(pfm)
					tr.AddNewlyCreatedDBObject(pfm, True)
					For i = 0 To npts - 1
						Dim vert As New PolyFaceMeshVertex(New Point3d(ptx(i), pty(i), ptz(i)))
						pfm.AppendVertex(vert)
						tr.AddNewlyCreatedDBObject(vert, True)
					Next
					For i = 0 To ntri - 1
						Dim face As New FaceRecord(CShort(pt1(i) + 1), CShort(pt2(i) + 1), CShort(pt3(i) + 1), 0)
						pfm.AppendFaceRecord(face)
						tr.AddNewlyCreatedDBObject(face, True)
					Next
				End If

				If createSubDMesh OrElse createSolid3d Then
					Dim vertarray As New Point3dCollection()
					Dim facearray As New Int32Collection()

					For i = 0 To npts - 1
						vertarray.Add(New Point3d(ptx(i), pty(i), ptz(i)))
					Next

					If createSolid3d Then
						For i = 0 To nouted - 1
							vertarray.Add(New Point3d(ptx(ed1(outed1(i))), pty(ed1(outed1(i))), zref))
						Next
					End If

					j = 0
					For i = 0 To ntri - 1
						facearray.Add(3)
						facearray.Add(pt1(i))
						facearray.Add(pt2(i))
						facearray.Add(pt3(i))
					Next

					If createSolid3d Then
						For i = 0 To nouted - 1
							facearray.Add(4)
							k = outed1(i)
							facearray.Add(ed1(k))
							facearray.Add(ed2(k))
							If i = nouted - 1 Then
								facearray.Add(npts)
							Else
								facearray.Add(npts + i + 1)
							End If
							facearray.Add(npts + i)
						Next
						facearray.Add(nouted)
						For i = 0 To nouted - 1
							facearray.Add(npts + i)
						Next
					End If

					Dim sdm As New SubDMesh()
					sdm.SetDatabaseDefaults()
					sdm.SetSubDMesh(vertarray, facearray, 0)
					btr.AppendEntity(sdm)
					tr.AddNewlyCreatedDBObject(sdm, True)

					If createSolid3d Then
						Dim sol As Solid3d = Nothing
						Try
							sol = sdm.ConvertToSolid(False, False)
							btr.AppendEntity(sol)
							tr.AddNewlyCreatedDBObject(sol, True)
						Catch
							ed.WriteMessage(vbLf & "Mesh was too complex to turn into a solid.")
						End Try
						If Not createSubDMesh Then
							sdm.[Erase]()
						End If
					End If
				End If

				tr.Commit()
			End Using
			If status1 > 0 Then
				ed.WriteMessage(vbLf & "Warning! {0} thin triangle(s) found!" & " Wrong result possible!", status1)
			End If
			Application.UpdateScreen()
		End Sub

		<CommandMethod("PFT")> _
		Public Sub PolyFaceTriangulate()
			TriangulatePoints(OutputObjectType.PolyFaceMesh, 32767)
		End Sub

		<CommandMethod("SDT")> _
		Public Sub SubDTriangulate()
			TriangulatePoints(OutputObjectType.SubDMesh, 200000)
		End Sub

		<CommandMethod("S3T")> _
		Public Sub Solid3dTriangulate()
			TriangulatePoints(OutputObjectType.Solid3d, 200000)
		End Sub
	End Class
End Namespace
Олег (jr.) вне форума  
 
Автор темы   Непрочитано 11.08.2013, 17:37
#12
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,793


Олег
Спасибо завтра попробую, сегодня день строителя.
Огромное спасибо.
Осталось сделать изолинии.
__________________
Шаг 12й......
Мои публикации

Последний раз редактировалось DEM, 12.08.2013 в 09:44.
DEM вне форума  
 
Автор темы   Непрочитано 15.08.2013, 10:16
#13
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,793


Тут возникла следующая идея, а что если сделать немного по проще, и создать матрицу на основе координат....
А потом уже по этой матрице строить горизонтали или изополя...
Правда желательно сделать вычисление промежуточных значений не линейное а квадратичное....
__________________
Шаг 12й......
Мои публикации
DEM вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > .NET > Как соеденить отрезками облако точек и построить изолинии. VB.net

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Какой язык перспективен для инженера-конструктора с условием The_Mercy_Seat Программирование 671 03.11.2019 16:26
Построить вертикальный отрезок заданной длины между двумя отрезками AURUM0301 AutoCAD 1 09.04.2013 12:10