Тема: Внутренние углы замкнутой полилинии
Как программно опрелелить внутренние углы замкнутой полилинии???
Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Внутренние углы замкнутой полилинии
Форумы CADUser → Программирование → VBA → Внутренние углы замкнутой полилинии
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Сообщения 23
- SmeL
- Активный участник
Re: Внутренние углы замкнутой полилинии
Координаты полилинни в массив, потом по 3 точкам вычисляем угол, а как это на бумаге сделать подскажет геометрия за 7 класс.
Re: Внутренние углы замкнутой полилинии
> SmeL
А если углы > 180 и > 270 градусов?
- SmeL
- Активный участник
Re: Внутренние углы замкнутой полилинии
а что Вас интересуют только углы отличные от 180 и 270 ?
- Олег(jr.)
- Восстановленный участник
Re: Внутренние углы замкнутой полилинии
> Kostya
Может сам добьешь, а то мне не по зубам
хорошие углы вычисляет хорошо, а в вогнутых
вершинах врет...
Option Explicit
Public Sub Get_Polyline_Angles()
Dim Util As AcadUtility
Dim oPline As AcadEntity
Dim ptArr As Variant
Dim i, j, k As Long
Dim basepnt As Variant
Dim fAngle, sAngle, incAng As Double
Dim pointA(0 To 2) As Double
Dim pointB(0 To 2) As Double
Dim pointC(0 To 2) As Double
Dim angArr() As Double
Dim strAng As String
Const pi As Double = 3.14159265358979
Set Util = ThisDrawing.Utility
Util.GetEntity oPline, basepnt, vbCr & "Select polyline :"
If TypeOf oPline Is AcadLWPolyline Then
ptArr = Get_LW_Points_For_Angles(oPline)
Else: MsgBox "This object is not a ""light"" polyline!"
Exit Sub
End If
strAng = ""
ReDim angArr(UBound(ptArr, 1) - 2)
For i = 0 To UBound(ptArr, 1) - 2
pointA(0) = ptArr(i, 0): pointA(1) = ptArr(i, 1): pointA(2) = 0#
pointB(0) = ptArr(i + 1, 0): pointB(1) = ptArr(i + 1, 1): pointB(2) = 0#
pointC(0) = ptArr(i + 2, 0): pointC(1) = ptArr(i + 2, 1): pointC(2) = 0#
fAngle = Rtd(Util.AngleFromXAxis(pointB, pointA))
sAngle = Rtd(Util.AngleFromXAxis(pointB, pointC))
incAng = Abs(fAngle - sAngle)
If incAng > 180 Then
incAng = Abs(360 - incAng)
End If
angArr(i) = incAng
strAng = strAng & CStr(incAng) & vbCrLf
Next
MsgBox strAng & vbCrLf & "Всего углов: " _
& CStr((UBound(angArr) + 1))
End Sub
Function Get_LW_Points_For_Angles(ByVal objPline As AcadLWPolyline) As Variant
Dim retCoors As Variant
Dim verx(0 To 2) As Double
Dim verxArr() As Variant
Dim i, j, k, n As Integer
retCoors = objPline.Coordinates
If objPline.Closed = True Then
n = UBound(retCoors) + 1
ReDim Preserve retCoors(n + 3)
retCoors(n) = retCoors(0)
retCoors(n + 1) = retCoors(1)
retCoors(n + 2) = retCoors(2)
retCoors(n + 3) = retCoors(3)
End If
k = (UBound(retCoors) - 1) \ 2
ReDim verxArr(k, 1)
i = 0
For j = 0 To UBound(retCoors) - 1 Step 2
verxArr(i, 0) = retCoors(j)
verxArr(i, 1) = retCoors(j + 1)
i = i + 1
Next
Get_LW_Points_For_Angles = verxArr
End Function
Function Rtd(defAng) As Double
Rtd = defAng / 3.14159265358979 * 180
End Function~'J'~
- LeonidSN
- Активный участник
Re: Внутренние углы замкнутой полилинии
Насколько я понимаю, главное здесь - определить с какой стороны от линии находится внутрення область замкнутого многоугольника. Вопрос не так уж прост, обсуждения этой темы возникали на форуме не раз, см., например:
https://www.caduser.ru/forum/topic3726.html
Может быть стоит поискать еще...
- Евгений Елпанов
- Активный участник
Re: Внутренние углы замкнутой полилинии
> LeonidSN
Зная, в какую сторону нарисованна полилиния (по часовой / против часовой) это совсем не сложно...
Как узнать направление, обсуждалось не раз, мой вариант на лиспе, есть в готовых программах.
- Олег(jr.)
- Восстановленный участник
Re: Внутренние углы замкнутой полилинии
> LeonidSN
Не, мне интересней как это на VBA
Идея такая: определить направление полилинии
(по часовой или против), углы наверно тогда лучше
будет вычислять через арктангенс и т.д.
потом сопоставлять куда заворачивает следующий
сегмент (вправо или влево)
Эх, не хватает, брат, серого вещества...
~'J'~
- Олег(jr.)
- Восстановленный участник
Re: Внутренние углы замкнутой полилинии
> Евгений Елпанов
Привет Евгений!
Во, пока писал, пришла поддержка, может я на правильном пути?
~'J'~
- Евгений Елпанов
- Активный участник
Re: Внутренние углы замкнутой полилинии
> Олег(jr.)
Конечно!
Я, за время работы с полилиниями, написал около 20 версий программы вычисления направления - всегда находилась полилиния, на которой программа спотыкалась...
Последняя версия работает всегда, можно сказать - гарантированно :)
Алгоритм самый простой
1 вычисляем вершины габаритного контейнера
2 находим ближайшие точки на полилинии из всех вершин габарита
3 Узнаем параметры всех точек и анализируем их последовательность.
как пример:
(defun c:lwcl(/ LW LST MAXP MINP) (setq lw(vlax-ename->vla-object(car(entsel)))) (vla-GetBoundingBox lw 'MinP 'MaxP) (setq minp(vlax-safearray->list minp) MaxP(vlax-safearray->list MaxP) lst(mapcar(function(lambda(x) (vlax-curve-getParamAtPoint lw (vlax-curve-getClosestPointTo lw x)))) (list minp(list(car minp)(cadr MaxP)) MaxP(list(car MaxP)(cadr minp))))) (if(or (<=(car lst)(cadr lst)(caddr lst)(cadddr lst)) (<=(cadr lst)(caddr lst)(cadddr lst)(car lst)) (<=(caddr lst)(cadddr lst)(car lst)(cadr lst)) (<=(cadddr lst)(car lst)(cadr lst)(caddr lst)))t))
- Олег(jr.)
- Восстановленный участник
Re: Внутренние углы замкнутой полилинии
> Евгений Елпанов
Вот тут нашел на мат. форуме теорему,
не знаю насколько правильно, слегка проверил,
вроде оно:
'\\\' Test on CW<->CCW Function
Public Function CW_CCW_Test(oPline As AcadLWPolyline) As Boolean
Dim oCoors As Variant
Dim px1, px2, px3, py1, py2, py3 As Double
Dim dirFlag As Boolean
oCoors = oPline.Coordinates
If UBound(oCoors) >= 5 Then
px1 = oCoors(0)
py1 = oCoors(1)
px2 = oCoors(2)
py2 = oCoors(3)
px3 = oCoors(4)
py3 = oCoors(5)
End If
If (px1 - px2) * (py3 - py2) - (py1 - py2) * (px3 - px2) < 0 Then
MsgBox "Counter clockwise direction"
dirFlag = True
Else
MsgBox "Clockwise direction"
dirFlag = False
End If
End FunctionИли опять соврамши?
~'J'~
- Евгений Елпанов
- Активный участник
Re: Внутренние углы замкнутой полилинии
> Олег(jr.)
Попробуй сделать разомкнутое колцо маленькой ширины чтоб внутренняя дуга была описанна линейными сегментами, а внешняя одним дуговым.
Для такой полилинии, анализ узловых точек не подходит...
Я тоже начинал с анализа вершин и углов.
Удачи!
- Олег(jr.)
- Восстановленный участник
Re: Внутренние углы замкнутой полилинии
> Евгений Елпанов
Я наверно общий случай сейчас опущу, поскольку
вопрос о замкнутых, а с ними функция работает
нормально, если я все учел...
Буду двигаться дальше, а к общему случаю еще вернусь
Спасибо еще раз
~'J'~
- Евгений Елпанов
- Активный участник
Re: Внутренние углы замкнутой полилинии
> Олег(jr.)
Я имел в виду замкнутую полилинию, в форме подковы или типа того...
Для примера:
(entmakex '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (410 . "Model") (100 . "AcDbPolyline") (90 . 12) (70 . 1) (10 -55.0 1.13687e-013) (42 . 0.387795) (10 -5.0 -54.7723) (42 . 0.0) (10 -5.0 -43.3013) (42 . 0.0) (10 -25.0 -43.3013) (42 . 0.0) (10 -50.0 1.13687e-013) (42 . 0.0) (10 -25.0 43.3013) (42 . 0.0) (10 25.0 43.3013) (42 . 0.0) (10 50.0 2.84217e-013) (42 . 0.0) (10 25.0 -43.3013) (42 . 0.0) (10 5.0 -43.3013) (42 . 0.0) (10 5.0 -54.7723) (42 . 0.387795) (10 55.0 1.13687e-013) (42 . 1.0) ))
- Александр Ривилис
- Активный участник
Re: Внутренние углы замкнутой полилинии
> Олег(jr.)
В таком виде алгоритм увы неверен. :( Фактически он вычисляет площадь (со знаком) замкнутой области. Так вот ошибка в том, что вычисляется площадь только для первых трех точек полилинии, а это не правильно - нужно вычислять полную площадь.
- Олег(jr.)
- Восстановленный участник
Re: Внутренние углы замкнутой полилинии
> Александр Ривилис
Я согласен.
Да, но для твоей функции мне нужно использовать
VLAX class, чтоб добраться до функций ActiveX,
а я чё-то не шибко пока в классах-то
Вот наскреб всяко-разно по сусекам, а и вроде
считает, пускай сам проверяет:
Option Explicit
'\\' get inner angles of closed lwpolyline
Public Sub Get_Polyline_Angles()
Dim Util As AcadUtility
Dim oPline As AcadEntity
Dim ptArr As Variant
Dim i, n, m As Long
Dim basepnt As Variant
Dim fAngle, sAngle, incAng As Double
Dim pointA(0 To 2) As Double
Dim pointB(0 To 2) As Double
Dim pointC(0 To 2) As Double
Dim angArr() As Double
Dim strAng As String
Dim flagDir As Boolean
Set Util = ThisDrawing.Utility
Util.GetEntity oPline, basepnt, vbCr & "Select polyline :"
If TypeOf oPline Is AcadLWPolyline Then
ptArr = Get_LW_Points(oPline)
Else: MsgBox "This object is not a ""light"" polyline!"
Exit Sub
End If
flagDir = TestClockWise(oPline)
Debug.Print flagDir
strAng = ""
ReDim angArr(UBound(ptArr, 1))
For i = 0 To UBound(ptArr, 1)
m = i + 1
Select Case i
Case 0: n = UBound(ptArr, 1): m = 1
Case UBound(ptArr, 1): n = UBound(ptArr, 1) - 1: m = 0
Case Else: n = i - 1: m = i + 1
End Select
pointA(0) = ptArr(n, 0): pointA(1) = ptArr(n, 1): pointA(2) = 0#
pointB(0) = ptArr(i, 0): pointB(1) = ptArr(i, 1): pointB(2) = 0#
pointC(0) = ptArr(m, 0): pointC(1) = ptArr(m, 1): pointC(2) = 0#
fAngle = R2d(Util.AngleFromXAxis(pointB, pointA))
sAngle = R2d(Util.AngleFromXAxis(pointB, pointC))
If flagDir = False Then
incAng = sAngle - fAngle
If incAng < 0 Then
incAng = Abs(360 + incAng)
End If
Else
incAng = fAngle - sAngle
If incAng > 180 Then
incAng = Abs(360 - incAng)
End If
If incAng < 0 Then
incAng = Abs(360 + incAng)
End If
End If
angArr(i) = incAng
Next
For i = 0 To UBound(angArr)
strAng = strAng & CStr(angArr(i)) & vbCrLf
Next
MsgBox strAng & vbCrLf & "Всего углов: " _
& CStr((UBound(angArr) + 1))
End Sub
'\\'Test on CW-CCW lwpolyline direction
Function TestClockWise(oPline As AcadLWPolyline) As Boolean
Dim iCnt As Long
Dim fAng As Double
Dim sAng As Double
Dim sumAng As Double
Dim ptArr As Variant
Dim fstPt(2) As Double
Dim sndPt(2) As Double
Dim dirFlag As Boolean
ptArr = oPline.Coordinates
fstPt(0) = ptArr(0)
fstPt(1) = ptArr(1)
sndPt(0) = ptArr(2)
sndPt(1) = ptArr(3)
fAng = ThisDrawing.Utility.AngleFromXAxis(fstPt, sndPt)
sumAng = fAng + (PI * 2)
fstPt(0) = sndPt(0)
fstPt(1) = sndPt(1)
On Error Resume Next
For iCnt = 4 To UBound(ptArr) - 1 Step 2
sndPt(0) = ptArr(iCnt)
sndPt(1) = ptArr(iCnt + 1)
sAng = ThisDrawing.Utility.AngleFromXAxis(fstPt, sndPt)
sumAng = IIf(sAng > fAng And _
sAng < fAng + PI, _
sumAng + sAng, _
sumAng - sAng)
fAng = sAng
fstPt(0) = sndPt(0)
fstPt(1) = sndPt(1)
Next
If sumAng > (PI * 2) Then
dirFlag = True
Else
dirFlag = False
End If
TestClockWise = dirFlag
End Function
'\\'Get two-dimensional array of lwpolyline points
Function Get_LW_Points(ByVal objPline As AcadLWPolyline) As Variant
Dim retCoors As Variant
Dim verx(0 To 2) As Double
Dim verxArr() As Variant
Dim i, j, k, n As Integer
retCoors = objPline.Coordinates
k = (UBound(retCoors) - 1) \ 2
ReDim verxArr(k, 1)
i = 0
For j = 0 To UBound(retCoors) - 1 Step 2
verxArr(i, 0) = retCoors(j)
verxArr(i, 1) = retCoors(j + 1)
i = i + 1
Next
Get_LW_Points = verxArr
End Function
'\\' convert radians to degres
Function R2d(rad As Double) As Double
R2d = (rad / PI) * 180
End Function
'\\' calculate PI value
Public Function PI() As Double
PI = Atn(1) * 4
End Function~'J'~
- Александр Ривилис
- Активный участник
Re: Внутренние углы замкнутой полилинии
> Олег(jr.)
Да, но для твоей функции мне нужно использовать
VLAX class, чтоб добраться до функций ActiveX
Это не в моей, а в Евгения Елпанова. :) Насколько мне известно в VBA нет аналогов lisp'овских функций vlax-curve-....
- Олег(jr.)
- Восстановленный участник
Re: Внутренние углы замкнутой полилинии
> Александр Ривилис
Извини Александр, чего-то я шибко невнимательный
сегодня, опять наверно магнитная буря...
Я имел ввиду VLAX.cls module с сайта www.acadx.com
который вроде позволяет использовать Vlips функции в VBA
~'J'~
- LeonidSN
- Активный участник
Re: Внутренние углы замкнутой полилинии
Евгений Елпанов пишет:
Зная, в какую сторону нарисованна полилиния (по часовой / против часовой) это совсем не сложно...
Как всегда, приходится уточнять условия задачи.
По-видимому, автор темы имел в виду ломаную линию. Определять углы между кривыми, это немножко другая опера. Однако даже в случае c ломаной остается возможность создания полилинии из отрезков (LINE, например) командой PLJOIN, и тут говорить о направлении построения бессмысленно. Список координат вершин такой полилинии выстраивается по возрастанию координаты X. Таким образом определение внутренней (или внешней) области остается единственным надежным критерием.
Можно прощупать области по обе стороны от линии, сыграв с ней в "морской бой" с помощью команды: BOUNDARY.
ThisDrawing.SendCommand "-boundary" & vbCr & "-2.92,7.27" & vbCr & vbCr
Dim Result As Variant
Result = ThisDrawing.GetVariable("LASTPROMPT")
MsgBox Result 'BOUNDARY created 1 polyline -попал
MsgBox Result 'Valid hatch boundary not found - не попал
ThisDrawing.SendCommand " "Здесь есть еще один нюанс, неизвестно между какими вершинами проходит линия.
Поэтому, для начала ее придется взорвать и зафиксировать концы отрезков.
- razruha
- Участник
Re: Внутренние углы замкнутой полилинии
(defun c:angle_poly ()
(defun acos (val)
(if (and (> val -1.0) (< val 1.0))
(+ (atan (/ (* -1.0 val) (sqrt (+ 1 (* val val -1.0)))))
(* 2.0 (atan 1))
) ;_ end of +
(if (= val -1.0)
pi
0
) ;_ end of if
) ;_ end of if
) ;_ end of defun
(defun del_from_list (lst)
(setq len (length lst))
(setq cnt 0)
(setq newlst nil)
(repeat (/ len 2)
(setq newlst (append newlst
(list (list (nth cnt lst) (nth (1+ cnt) lst)))
) ;_ end of append
) ;_ end of setq
(setq cnt (+ 2 cnt))
) ;_ end of repeat
(setq newlst (append newlst (list (list (car lst) (cadr lst)))))
(del_from_list1 newlst)
) ;_ end of defun
(defun del_from_list1 (ls)
(if (> (length ls) 1)
(progn
(if (/= (distance (car ls) (cadr ls)) 0)
(cons (car ls) (del_from_list1 (cdr ls)))
(del_from_list1 (cdr ls))
) ;_ end of if
) ;_ end of progn
nil
) ;_ end of if
) ;_ end of defun
(vl-load-com)
(setq ms (vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
) ;_ end of vla-get-modelspace
) ;_ end of setq
(setq poly (vlax-ename->vla-object (car (entsel "Polyline\n"))))
(setq list_vertex
(vlax-safearray->list
(vlax-variant-value (vla-get-coordinates poly))
) ;_ end of vlax-safearray->list
) ;end of setq
(setq list_vertex (del_from_list list_vertex))
(setq angle_num (length list_vertex))
(if (> angle_num 2)
(progn
(setq count 0)
(setq full_area (vla-get-area poly))
(repeat angle_num
(progn
(setq arr_vertex_pl
(vlax-make-safearray
vlax-vbdouble
(cons 0 (- (* 2 (- angle_num 1)) 1))
) ;_ end of vlax-make-safearray
) ;_ end of setq
(setq count_arr 0)
(setq count_new 0)
(repeat angle_num
(progn
(if (/= count count_new)
(progn
(vlax-safearray-put-element
arr_vertex_pl
(* 2 count_arr)
(car (nth count_new list_vertex))
);x
(vlax-safearray-put-element
arr_vertex_pl
(+ 1 (* 2 count_arr))
(cadr (nth count_new list_vertex))
);y
(setq count_arr (1+ count_arr))
) ;_ end of progn
) ;_ end of if
(setq count_new (1+ count_new))
) ;_ end of progn
) ;_ end of repeat
(setq variant_arr (vlax-make-variant arr_vertex_pl))
(setq new_pl (vla-addlightweightpolyline ms variant_arr))
(vla-put-closed new_pl :vlax-true)
(setq new_area (vla-get-area new_pl))
(vla-delete new_pl)
(setq pt1
(list
(car (nth (rem (+ angle_num (- count 1))
angle_num
) ;_ end of rem
list_vertex
) ;_ end of nth
) ;x
(cadr (nth (rem (+ angle_num (- count 1))
angle_num
) ;_ end of rem
list_vertex
) ;_ end of nth
) ;y
0
) ;_ end of list
pt2
(list
(car (nth (rem count angle_num) list_vertex)) ;x
(cadr (nth (rem count angle_num) list_vertex)) ;y
0
) ;_ end of list
pt3
(list
(car (nth (rem (+ count 1) angle_num) list_vertex)) ;x
(cadr (nth (rem (+ count 1) angle_num) list_vertex)) ;y
0
) ;_ end of list
) ;_ end of setq
(setq l1 (distance pt1 pt2)
l2 (distance pt2 pt3)
l3 (distance pt1 pt3)
) ;_ end of setq
(setq alpha (acos (/ (- (* l3 l3) (* l2 l2) (* l1 l1)) (* -2.0 l1 l2))))
(if (> new_area full_area)
(setq alpha (- (* 2.0 pi) alpha)) ;for outer
) ;_ end of if
(setq ang (/ (* 180 alpha) pi))
(setq count (1+ count))
(print ang)
) ;_ end of progn
) ;_ end of repeat
) ;_ end of progn
(print "Two vertex")
) ;_ end of if
(print)
) ;_ end of defunВообщен не хватило мне фантазии на полилинию, для которой бы не работало.
Хотя и на LISP но переложить на VBA не сложно, главное идея.
Re: Внутренние углы замкнутой полилинии
Уважаемые, киньте пожалуйста ссылочку на vlax.cls, а то по адресу http://www.acadx.com/ бред какой-то выходит.
Re: Внутренние углы замкнутой полилинии
вот чего-то здесь нашел
http://discussion.autodesk.com/thread.j … ID=4986646
Сообщения 23
Тему читают: 1 гость
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → VBA → Внутренние углы замкнутой полилинии
Форум работает на PunBB, при поддержке Informer Technologies, Inc
