### Author Topic: find all possible triangles  (Read 2926 times)

0 Members and 1 Guest are viewing this topic.

#### domenicomaria

• Bull Frog
• Posts: 434 ##### find all possible triangles
« on: February 23, 2022, 02:48:54 PM »
I have a list of sublists.
(("B" "G" "6.282086933")
("B" "F" "12.976023715")
("C" "F" "11.751394742")
("C" "E" "7.920859120")
("C" "H" "15.483368483")
("E" "F" "11.976802376")
("E" "G" "16.388551798")
("F" "H" "9.646161098")
("F" "G" "9.569086831")
("F" "L" "14.026078332")
("G" "L" "5.537434050")
("G" "H" "5.415422978")
("H" "L" "5.498351129")
("H" "K" "8.321609235")
("I" "J" "7.240508295")
("K" "L" "7.047455245")
)
Each sublist represents a segment identified by two vertices identified by a letter
and by a string that represents the distance between the two vertices.

The third value (the string that represents the distance between the two vertices)
in this phase has no importance ...

I need to find all possible triangles ...
... for example E C F is one of them ...
("C" "F" "11.751394742")
("E" "F" "11.976802376")
("C" "E" "7.920859120")
...
... another is F L G

("F" "L" "14.026078332")
("F" "G" "9.569086831")
("G" "L" "5.537434050")

... does anyone have any ideas?

#### domenicomaria

• Bull Frog
• Posts: 434 ##### Re: find all possible triangles
« Reply #1 on: February 23, 2022, 03:24:59 PM »
Code - Auto/Visual Lisp: [Select]
1. (setq vvd-lst '(("I" "J" "7.240508295") ("H" "L" "5.498351129") ("G" "L" "5.537434050") ("G" "H" "5.415422978") ("F" "H" "9.646161098") ("F" "G" "9.569086831") ("B" "G" "6.282086933") ("B" "F" "12.976023715") ("C" "F" "11.751394742") ("E" "F" "11.976802376") ("C" "E" "7.920859120") ("H" "K" "8.321609235") ("K" "L" "7.047455245") ("F" "L" "14.026078332") ("C" "H" "15.483368483") ("E" "G" "16.388551798")))
2.
3. (setq  n-rep (length vvd-lst) ind 0)
4. (repeat n-rep
5.    (setq item (nth ind vvd-lst)   v1 (car item) v2 (cadr item) vvd-lst- (vl-remove item vvd-lst) )
6.    (setq trngls-lst (cons (cons item (vl-remove nil (mapcar '(lambda (i) (if (or (member v1 i) (member v2 i) ) i)       )       vvd-lst-        ) ) ) trngls-lst) )
7.    (setq ind (+ 1 ind) )
8. )
9. trngls-lst
10.
11. ((("E" "G" "16.388551798")
12.          ("G" "L" "5.537434050")
13.          ("G" "H" "5.415422978")
14.          ("F" "G" "9.569086831")
15.          ("B" "G" "6.282086933")
16.          ("E" "F" "11.976802376")
17.          ("C" "E" "7.920859120")
18.  )      (("C" "H" "15.483368483")
19.                 ("H" "L" "5.498351129")
20.                 ("G" "H" "5.415422978")
21.                 ("F" "H" "9.646161098")
22.                 ("C" "F" "11.751394742")
23.                 ("C" "E" "7.920859120")
24.                 ("H" "K" "8.321609235")
25.         )
26.         (("F" "L" "14.026078332")
27.                 ("H" "L" "5.498351129")
28.                 ("G" "L" "5.537434050")
29.                 ("F" "H" "9.646161098")
30.                 ("F" "G" "9.569086831")
31.                 ("B" "F" "12.976023715")
32.                 ("C" "F" "11.751394742")
33.                 ("E" "F" "11.976802376")
34.                 ("K" "L" "7.047455245")
35.         )
36.         (("K" "L" "7.047455245")
37.                 ("H" "L" "5.498351129")
38.                 ("G" "L" "5.537434050")
39.                 ("H" "K" "8.321609235")
40.                 ("F" "L" "14.026078332")
41.         )
42.         (("H" "K" "8.321609235")
43.                 ("H" "L" "5.498351129")
44.                 ("G" "H" "5.415422978")
45.                 ("F" "H" "9.646161098")
46.                 ("K" "L" "7.047455245")
47.                 ("C" "H" "15.483368483")
48.         )
49.         (("C" "E" "7.920859120")
50.                 ("C" "F" "11.751394742")
51.                 ("E" "F" "11.976802376")
52.                 ("C" "H" "15.483368483")
53.                 ("E" "G" "16.388551798")
54.         )
55.         (("E" "F" "11.976802376")
56.                 ("F" "H" "9.646161098")
57.                 ("F" "G" "9.569086831")
58.                 ("B" "F" "12.976023715")
59.                 ("C" "F" "11.751394742")
60.                 ("C" "E" "7.920859120")
61.                 ("F" "L" "14.026078332")
62.                 ("E" "G" "16.388551798")
63.         )
64.         (("C" "F" "11.751394742")
65.                 ("F" "H" "9.646161098")
66.                 ("F" "G" "9.569086831")
67.                 ("B" "F" "12.976023715")
68.                 ("E" "F" "11.976802376")
69.                 ("C" "E" "7.920859120")
70.                 ("F" "L" "14.026078332")
71.                 ("C" "H" "15.483368483")
72.         )
73.         (("B" "F" "12.976023715")
74.                 ("F" "H" "9.646161098")
75.                 ("F" "G" "9.569086831")
76.                 ("B" "G" "6.282086933")
77.                 ("C" "F" "11.751394742")
78.                 ("E" "F" "11.976802376")
79.                 ("F" "L" "14.026078332")
80.         )
81.         (("B" "G" "6.282086933")
82.                 ("G" "L" "5.537434050")
83.                 ("G" "H" "5.415422978")
84.                 ("F" "G" "9.569086831")
85.                 ("B" "F" "12.976023715")
86.                 ("E" "G" "16.388551798")
87.         )
88.         (("F" "G" "9.569086831")
89.                 ("G" "L" "5.537434050")
90.                 ("G" "H" "5.415422978")
91.                 ("F" "H" "9.646161098")
92.                 ("B" "G" "6.282086933")
93.                 ("B" "F" "12.976023715")
94.                 ("C" "F" "11.751394742")
95.                 ("E" "F" "11.976802376")
96.                 ("F" "L" "14.026078332")
97.                 ("E" "G" "16.388551798")
98.         )
99.         (("F" "H" "9.646161098")
100.                 ("H" "L" "5.498351129")
101.                 ("G" "H" "5.415422978")
102.                 ("F" "G" "9.569086831")
103.                 ("B" "F" "12.976023715")
104.                 ("C" "F" "11.751394742")
105.                 ("E" "F" "11.976802376")
106.                 ("H" "K" "8.321609235")
107.                 ("F" "L" "14.026078332")
108.                 ("C" "H" "15.483368483")
109.         )
110.         (("G" "H" "5.415422978")
111.                 ("H" "L" "5.498351129")
112.                 ("G" "L" "5.537434050")
113.                 ("F" "H" "9.646161098")
114.                 ("F" "G" "9.569086831")
115.                 ("B" "G" "6.282086933")
116.                 ("H" "K" "8.321609235")
117.                 ("C" "H" "15.483368483")
118.                 ("E" "G" "16.388551798")
119.         )
120.         (("G" "L" "5.537434050")
121.                 ("H" "L" "5.498351129")
122.                 ("G" "H" "5.415422978")
123.                 ("F" "G" "9.569086831")
124.                 ("B" "G" "6.282086933")
125.                 ("K" "L" "7.047455245")
126.                 ("F" "L" "14.026078332")
127.                 ("E" "G" "16.388551798")
128.         )
129.         (("H" "L" "5.498351129")
130.                 ("G" "L" "5.537434050")
131.                 ("G" "H" "5.415422978")
132.                 ("F" "H" "9.646161098")
133.                 ("H" "K" "8.321609235")
134.                 ("K" "L" "7.047455245")
135.                 ("F" "L" "14.026078332")
136.                 ("C" "H" "15.483368483")
137.         )
138.         (("I" "J" "7.240508295"))
139. )
140.

this could be a first step ...

« Last Edit: February 24, 2022, 02:58:45 AM by domenicomaria » ##### Re: find all possible triangles
« Reply #2 on: February 28, 2022, 03:55:51 AM »
So we are here with triangles...
What shell we do next...

Code - Auto/Visual Lisp: [Select]
1. ;;; analyze of irregular polygon - problem of finding shape of irregular polygon based on input data refering all measured distances between all point pairs ;;;
2. ;;; dedicated topic : http://www.theswamp.org/index.php?topic=57402.0 ;;;
3.
4. (defun c:decomposition+composition ( / uniquetrl comb trianglst LM:popup lw lwx pl plcomb trl )
5.
6.   (vl-load-com) ;;; load ActiveX extensions (VLA functions) - needed only for (LM:popup) ;;;
7.
8.   (defun uniquetrl ( trl )
9.     (if trl (cons (car trl) (uniquetrl (vl-remove-if '(lambda ( x ) (vl-every '(lambda ( y ) (vl-some '(lambda ( z ) (equal y z 1e-6)) (car trl))) x)) (cdr trl)))))
10.   )
11.
12.   (defun comb ( lst / l r )
13.     (setq l lst)
14.     (foreach i1 lst
15.       (setq lst (cdr lst))
16.       (foreach i2 lst
17.         (setq r (cons (list (vl-position i1 l) (vl-position i2 l) (distance i1 i2)) r))
18.       )
19.     )
20.     r
21.   )
22.
23.   (defun trianglst ( plcomb / l trl r )
24.     (setq l plcomb)
25.     (foreach edge plcomb
26.       (setq plcomb (cdr plcomb))
27.       (foreach next plcomb
28.         (if (or (= (car edge) (car next)) (= (car edge) (cadr next)) (= (cadr edge) (car next)) (= (cadr edge) (cadr next)))
29.           (setq trl (cons (list edge next) trl))
30.         )
31.       )
32.     )
33.     (setq plcomb l)
34.     (foreach 2edges trl
35.       (foreach edge plcomb
36.         (if
37.           (and
38.             (or
39.               (and (vl-position (car edge) (car 2edges)) (vl-position (cadr edge) (cadr 2edges)))
40.               (and (vl-position (car edge) (cadr 2edges)) (vl-position (cadr edge) (car 2edges)))
41.             )
42.             (not (vl-position edge 2edges))
43.           )
44.           (setq r (cons (append 2edges (list edge)) r))
45.         )
46.       )
47.     )
48.     r
49.   )
50.
51.   ;; Popup  -  Lee Mac
52.   ;; A wrapper for the WSH popup method to display a message box prompting the user.
53.   ;; ttl - [str] Text to be displayed in the pop-up title bar
54.   ;; msg - [str] Text content of the message box
55.   ;; bit - [int] Bit-coded integer indicating icon & button appearance
56.   ;; Returns: [int] Integer indicating the button pressed to exit
57.
58.   (defun LM:popup ( ttl msg bit / wsh rtn )
59.     (if (setq wsh (vlax-create-object "wscript.shell"))
60.         (setq rtn (vl-catch-all-apply 'vlax-invoke-method (list wsh 'popup msg 0 ttl bit)))
61.         (vlax-release-object wsh)
62.         (if (not (vl-catch-all-error-p rtn)) rtn)
63.       )
64.     )
65.   )
66.
67.   (if (or (not (setq lw (car (entsel "\nPick closed polygonal LWPOLYLINE...")))) (and lw (= (cdr (assoc 0 (setq lwx (entget lw)))) "LWPOLYLINE") (= 1 (logand 1 (cdr (assoc 70 lwx)))) (vl-every 'zerop (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 42)) lwx)))))
68.       (setq pl (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) lwx)))
69.       (setq plcomb (comb pl))
70.       (princ (setq trl (uniquetrl (trianglst plcomb))))
71.       ;;; ... we are here with triangles ... ;;;
72.       (textscr)
73.     )
74.       (prompt "\nMissed..., or picked wrong entity type, or picked LWPOLYLINE not closed, or picked LWPOLYLINE not polygonal - has arced segments...")
75.       (if (= 4 (LM:popup "DECOMPOSITION+COMPOSITION - IRREGULAR POLYGON" "Choose option : " 53))
76.         (c:decomposition+composition)
77.       )
78.     )
79.   )
80.   (princ)
81. )
82.
« Last Edit: February 28, 2022, 04:51:17 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture) #### domenicomaria

• Bull Frog
• Posts: 434 ##### Re: find all possible triangles
« Reply #3 on: February 28, 2022, 04:59:34 AM »
Marko thank you so much for your attention !

In the meantime I have found my solution.
(I just have to check it and organize it better).

And I'll attach mine too, as soon as I have a little time.

Thanks a lot anyway.

Ciao ##### Re: find all possible triangles
« Reply #4 on: February 28, 2022, 06:44:52 AM »
Now...
I just set problem in terms of simple pick LWPOLY manner...

We have triangles...

1. Analyze of relation of common edge :

Each edge of triangle can form 4 different dispositions (solution triangles)...
2 of those 4 are correct if we seek for initial - final composition matching...
Those 2 must be in such relation that they share common edge and 2 vertices are on opposed sides...
We have only vertices indexes - not positions - so we don't know if they belong to initial entity (LWPOLY) or not...

2. Analyze of relation between possible groups formed from step 1. :

One important condition comes to mind : When grouping groups from step 1. : Neither of triangles should intersect each other...
When grouping groups :
(oserving angles around vertices)
Maximal angle that can form triangles around each of observed vertex (possible final soultion) must not exceed 360 degree (full circle), otherwise - triangles would intersect anyhoo...
Minimal angle around vertex (possible final solution) can be just exatly one of the angles belonging that one triangle - solution vertex don't have common sharing with any of other triangles - it's unique just for that one observed triangle, thus other vertices must have shared other triangle - we simply don't have 3 point LWPOLY - we are seeking for general solution that involves 3 or more vertices...

3. Analyze distances parameter in relation to grouping starting pair groups and grouping pairs into bigger gropus and then groups of gropus, ... (-||-) ...

Relation of measured distances by observing reference triangle - triangles properties by lengths of edges :

Common edge length is longest - longer than other edges of triangles if and only if opposite corresponding vertex of observed triangle(s) fall inside an area of intersection of 2 adjacent circles with centers = start/end vertices of common edge and radius is equal length of common edge...
Otherwise, it is smaller than any of other edges if opposed corresponding vertex fall outside this area, but it can/could be in area defined by one circle and in that case not in area described by other one...
Common edge length is smallest - smaller than other 2 edges of observed triangle if and only if opposite corresponding vertex fall outside of both circles start/end edge vertices and radius equals length edge...

Common edge of obseved pair - step 1. :

*** no relevant conclusions - if relations exist for one triangle in one manner, it doesn't mean it could be the same with adjacent triangle sharing the same common edge...

Common edge of observed pairs group :

*** what can we assume here as common edge?
When grouping groups of pairs - if one triangle belongs to both groups of pairs - it should be excluded from observations - we must remove duplicates - common triangles, but we must include them when forming pairs... IMHO - the best way of composing/grouping pairs groups is to match relations just exaclty over commonly shared triangle (i.e. commonly shared triangle describes 2 commonly shared edges, such that they must be adjacent to each other and so pair of group of pairs share common vetex - belonging to both common edges and share common angle (middle angle of 3 aound observed common vertex) - so bigger group consists of 3 triangles...

Common edge of observed group of groups :

*** like from previous conclusions - appropriate consideration is not common edge, but common triangle over which we are composing bigger composition... IMHO - the best way of composing/grouping groups of groups is to match relations just exaclty over commonly shared triangle / or even commonly shared group - so bigger group consists of 3 groups...

*** *** ***
No matter how we group things together, after each process of grouping (wheather it's going to be iteration / recursion - doesn't matter) with every pass, we must ensure, we remove commonly shared element (triangle) and therefore stay opened for all alternatives considering new sharing element (triangle) for next pass/grouping process from rest of others (all exept removed one) - previously commonly shared grouping connection (previous pass)...
Marko Ribar, d.i.a. (graduated engineer of architecture)  ##### Re: find all possible triangles
« Reply #5 on: March 01, 2022, 04:00:32 PM »
Here is continuation...

But very naive approach without too much thinking - just staight forward...

And there are some issues that are happening - simply CAD is stuggling to do it and there are overlappings, but when I thought over it - if everything passes final gather with union of regions and exploding and joining into LWPOLY those overlappings should disappear... But - too complex... That's all for now as much as I could think of... At least things are going in some direction - I am hoping in some positive way - to (some) final solution...

Code - Auto/Visual Lisp: [Select]
1. ;;; analyze of irregular polygon - problem of finding shape of irregular polygon based on input data refering all measured distances between all point pairs ;;;
2. ;;; dedicated topic : http://www.theswamp.org/index.php?topic=57402.0 ;;;
3.
4. (defun c:decomposition+composition ( / *error* uniquetrl comb trianglst LM:popup processtr makelwtr ci1xci2
5.                                        cmd pea lw lwx pl plcomb trl edgesl p chk lws tr el regs ss reg enx
6.                                    )
7.
9.
10.   (defun *error* ( m )
11.     (if (= 8 (logand 8 (getvar (quote undoctl))))
12.       (if command-s
13.         (command-s "_.undo" "_e")
14.         (vl-cmdf "_.undo" "_e")
15.       )
16.     )
17.     (if cmd
18.       (setvar (quote cmdecho) cmd)
19.     )
20.     (if pea
21.       (setvar (quote peditaccept) pea)
22.     )
23.     (if m
24.       (prompt m)
25.     )
26.     (princ)
27.   )
28.
29.   (defun uniquetrl ( trl )
30.     (if trl
31.       (cons (car trl)
32.         (uniquetrl
33.           (vl-remove-if
34.             (function (lambda ( x )
35.                 (function (lambda ( y )
36.                     (function (lambda ( z ) (equal y z 1e-6)))
37.                     (car trl)
38.                   )
39.                 ))
40.                 x
41.               )
42.             ))
43.             (cdr trl)
44.           )
45.         )
46.       )
47.     )
48.   )
49.
50.   (defun comb ( lst / ll r )
51.     (setq ll lst)
52.     (foreach i1 lst
53.       (setq lst (cdr lst))
54.       (foreach i2 lst
55.         (setq r
56.           (cons
57.             (list
58.               (vl-position i1 ll)
59.               (vl-position i2 ll)
60.               (distance i1 i2)
61.             )
62.             r
63.           )
64.         )
65.       )
66.     )
67.     r
68.   )
69.
70.   (defun trianglst ( plcomb / ll trl r )
71.     (setq ll plcomb)
72.     (foreach edge plcomb
73.       (setq plcomb (cdr plcomb))
74.       (foreach next plcomb
75.         (if
76.           (or
77.             (= (car edge) (car next))
78.             (= (car edge) (cadr next))
79.             (= (cadr edge) (car next))
81.           )
82.           (setq trl
83.             (cons (list edge next) trl)
84.           )
85.         )
86.       )
87.     )
88.     (setq plcomb ll)
89.     (foreach 2edges trl
90.       (foreach edge plcomb
91.         (if
92.           (and
93.             (or
94.               (and
95.                 (vl-position (car edge) (car 2edges))
97.               )
98.               (and
99.                 (vl-position (car edge) (cadr 2edges))
100.                 (vl-position (cadr edge) (car 2edges))
101.               )
102.             )
103.             (not (vl-position edge 2edges))
104.           )
105.           (setq r
106.             (cons
107.               (append 2edges (list edge))
108.               r
109.             )
110.           )
111.         )
112.       )
113.     )
114.     r
115.   )
116.
117.   ;; Popup  -  Lee Mac
118.   ;; A wrapper for the WSH popup method to display a message box prompting the user.
119.   ;; ttl - [str] Text to be displayed in the pop-up title bar
120.   ;; msg - [str] Text content of the message box
121.   ;; bit - [int] Bit-coded integer indicating icon & button appearance
122.   ;; Returns: [int] Integer indicating the button pressed to exit
123.
124.   (defun LM:popup ( ttl msg bit / wsh rtn )
125.     (if (setq wsh (vlax-create-object "wscript.shell"))
126.         (setq rtn
127.           (vl-catch-all-apply (function vlax-invoke-method)
128.             (list wsh (quote popup) msg 0 ttl bit)
129.           )
130.         )
131.         (vlax-release-object wsh)
132.         (if (not (vl-catch-all-error-p rtn)) rtn)
133.       )
134.     )
135.   )
136.
137.   (defun processtr ( tr p ang / p1 p2 p3 q edl tre ll )
138.     (setq p1 p)
139.     (setq p2 (polar p ang (caddar tr)))
141.     (foreach p3 q
142.       (if (and p1 p2 p3)
143.         (setq lws
144.           (cons
145.             (makelwtr p1 p2 p3)
146.             lws
147.           )
148.         )
149.       )
150.       (setq edl
151.         (list
152.           (distance p2 p3)
153.           (distance p3 p1)
154.         )
155.       )
156.       (setq trl (vl-remove tr trl))
157.       (foreach ed edl
158.         (setq tre
159.           (vl-remove-if-not
160.             (function (lambda ( x )
161.                 (function (lambda ( y )
162.                   (equal ed (caddr y) 1e-6)
163.                 ))
164.                 x
165.               )
166.             ))
167.             trl
168.           )
169.         )
170.         (foreach te tre
171.           (while (not (equal ed (caddar te) 1e-6))
173.           )
174.           (cond
176.               (setq ll (cons (list te p3 (angle p3 p2)) ll))
177.             )
179.               (setq ll (cons (list te p3 (angle p3 p1)) ll))
180.             )
181.           )
182.         )
183.       )
184.     )
185.     (foreach tr ll
186.       (setq trl
187.         (vl-remove-if
188.           (function (lambda ( x )
189.               (function (lambda ( y )
190.                   (function (lambda ( z )
191.                     (equal y z 1e-6)
192.                   ))
193.                   (car tr)
194.                 )
195.               ))
196.               x
197.             )
198.           ))
199.           trl
200.         )
201.       )
203.     )
204.   )
205.
206.   (defun makelwtr ( p1 p2 p3 )
207.       (list
208.         (cons 0 "LWPOLYLINE")
209.         (cons 100 "AcDbEntity")
210.         (cons 100 "AcDbPolyline")
211.         (cons 90 3)
212.         (cons 70 (1+ (* 128 (getvar (quote plinegen)))))
213.         (cons 38 0.0)
214.         (cons 10 p1)
215.         (cons 10 p2)
216.         (cons 10 p3)
217.         (list 210 0.0 0.0 1.0)
218.       )
219.     )
220.   )
221.
222.   ;; 2-Circle Intersection (trans version)  -  Lee Mac
223.   ;; Returns the point(s) of intersection between two circles
224.   ;; with centres c1,c2 and radii r1,r2
225.
226.   (defun ci1xci2 ( c1 r1 c2 r2 / n d1 x z )
227.     (if
228.       (and
229.         (or
230.           (< (setq d1 (distance c1 c2)) (+ r1 r2))
231.           (equal d1 (+ r1 r2) 1e-6)
232.         )
233.         (or
234.           (< (abs (- r1 r2)) d1)
235.           (equal (abs (- r1 r2)) d1 1e-6)
236.         )
237.       )
238.         (setq n (mapcar (function -) c2 c1))
239.         (setq c1 (trans c1 0 n))
240.         (setq z (abs (/ (- (+ (* r1 r1) (* d1 d1)) (* r2 r2)) (+ d1 d1))))
241.         (if (equal z r1 1e-6)
242.           (list (trans (list (car c1) (cadr c1) (+ (caddr c1) z)) n 0))
243.             (setq x (sqrt (- (* r1 r1) (* z z))))
244.             (list
245.               (trans (list (- (car c1) x) (cadr c1) (+ (caddr c1) z)) n 0)
246.               (trans (list (+ (car c1) x) (cadr c1) (+ (caddr c1) z)) n 0)
247.             )
248.           )
249.         )
250.       )
251.     )
252.   )
253.
254.   (setq cmd (getvar (quote cmdecho)))
255.   (setvar (quote cmdecho) 0)
256.   (setq pea (getvar (quote peditaccept)))
257.   (setvar (quote peditaccept) 1)
258.   (if (= 8 (logand 8 (getvar (quote undoctl))))
259.     (if command-s
260.       (command-s "_.undo" "_e")
261.       (vl-cmdf "_.undo" "_e")
262.     )
263.   )
264.   (if command-s
265.     (command-s "_.undo" "_m")
266.     (vl-cmdf "_.undo" "_m")
267.   )
268.   (if
269.     (or
270.       (not (setq lw (car (entsel "\nPick closed polygonal LWPOLYLINE..."))))
271.       (and
272.         lw
273.         (= (cdr (assoc 0 (setq lwx (entget lw)))) "LWPOLYLINE")
274.         (= 1 (logand 1 (cdr (assoc 70 lwx))))
275.             (vl-remove-if
276.               (function (lambda ( x )
277.                 (/= (car x) 42)
278.               ))
279.               lwx
280.             )
281.           )
282.         )
283.       )
284.     )
285.       (setq pl
286.           (vl-remove-if
287.             (function (lambda ( x )
288.               (/= (car x) 10)
289.             ))
290.             lwx
291.           )
292.         )
293.       )
294.       (setq plcomb (comb pl))
295.       (setq trl (uniquetrl (trianglst plcomb))) ;;; trl=(((n11 n12 d11) (n12 n13 d12) (n13 n11 d13)) ((n21 n22 d21) (n22 n23 d22) (n23 n21 d23)) ((n31 n32 d31) (n32 n33 d32) (n33 n31 d33)) ... )
296.       ;;; (princ trl) ;;;
297.       ;;; ... we are here with triangles ... ;;;
298.       ;;; To tackle the problem, we should think of 3D/2D (spacial) triangular dimensional determination in some kind of point additional order : 3 points - triangle = 3; 4 pts = 3 points - triangle + 3 additional edges from each point of triangle to 4th point = 6 ::: formulation : n*(n-1)/2 ::: 4*(4-1)/2=6 ; 5 pts ::: 5*(5-1)/2=10 ; ...
299.       ;;; Order goes like this : 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...
300.       (setq edgesl (vl-sort (apply (function append) trl) (function (lambda ( a b ) (> (caddr a) (caddr b)))))) ;;; edges sorted from longest to shortest ;;;
301.       (setq trl (vl-sort trl (function (lambda ( a b ) (< (+ (vl-position (car a) edgesl) (vl-position (cadr a) edgesl) (vl-position (caddr a) edgesl)) (+ (vl-position (car b) edgesl) (vl-position (cadr b) edgesl) (vl-position (caddr b) edgesl))))))) ;;; triangles sorted from longest to shortest ;;;
302.       (initget 1)
303.       (setq p (getpoint "\nPick point : "))
304.         (and
305.           trl
306.           (not (setq chk (equal tr (car trl) 1e-6)))
307.           (setq tr (car trl))
308.         )
309.         (if chk
310.             (prompt "\nLooping haven't passed correctly - some triangles from list trl haven't been processed...")
311.             (if (/= 6 (LM:popup "CONTINUE WITH PROCESSING - YES / QUIT - NO" "Choose option : " 36))
312.               (exit)
313.             )
314.           )
315.         )
316.           (not
317.             (and
320.             )
321.           )
323.         )
324.         (processtr tr p 0.0)
325.       )
326.       (if (= 6 (LM:popup "RESULTING TRIANGLES COMPOSED - PROCEED TO UNION TO FINAL OUTLINE LWPOLY" "Choose option : " 36))
327.           (setq el (entlast))
328.           (foreach lww lws
329.             (setq regs
330.               (cons
331.                   (vl-cmdf "_.region" lww "")
332.                   (if (not (eq el (setq el (entlast))))
333.                     el
334.                   )
335.                 ) regs
336.               )
337.             )
338.           )
340.           (foreach reg regs
342.           )
343.           (vl-cmdf "_.union" ss "")
344.           (if
345.             (setq regs
346.               (vl-remove-if (function vlax-erased-p) regs)
347.             )
349.               (setq reg (car regs))
350.             )
351.           )
352.           (if (= (cdr (assoc 0 (entget (if reg reg (setq reg (entlast)))))) "REGION")
353.               (vl-cmdf "_.explode" reg)
354.               (while (< 0 (getvar (quote cmdactive)))
355.                 (vl-cmdf "")
356.               )
357.               (setq el (entlast))
358.               (setq ss (ssget "_P"))
359.               (vl-cmdf "_.pedit" "_m" ss "" "_j")
360.               (while (< 0 (getvar (quote cmdactive)))
361.                 (vl-cmdf "")
362.               )
363.               (if
364.                 (or
365.                   (eq el (setq el (entlast)))
366.                   (= (cdr (assoc 0 (setq enx (entget el)))) "LWPOLYLINE")
367.                 )
368.                   (cdr
369.                     (assoc -1
370.                         (if (assoc 62 enx)
371.                           (subst (cons 62 3) (assoc 62 enx) enx)
372.                           (append enx (list (cons 62 3)))
373.                         )
374.                       )
375.                     )
376.                   )
377.                 )
378.               )
379.               (prompt "\nSource LWPOLYLINE length : ") (princ (vla-get-length (vlax-ename->vla-object lw)))
380.               (prompt "\nResulting LWPOLYLINE length : ") (princ (vla-get-length (vlax-ename->vla-object el)))
381.             )
382.           )
383.         )
384.       )
385.       (if trl
386.           (prompt "\nSome triangles haven't been processed...")
387.           (if (= 6 (LM:popup "SHOW UNPROCESSED TRIANGLES" "Choose option : " 36))
388.             (princ trl)
389.           )
390.           (prompt "\nTotal : ") (princ (length trl)) (prompt " unprocessed triangles...")
391.         )
392.       )
393.       (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
394.     )
395.       (prompt "\nMissed..., or picked wrong entity type, or picked LWPOLYLINE not closed, or picked LWPOLYLINE not polygonal - has arced segments...")
396.       (if (= 4 (LM:popup "DECOMPOSITION+COMPOSITION - IRREGULAR POLYGON" "Choose option : " 53))
397.         (c:decomposition+composition)
398.       )
399.     )
400.   )
401.   (*error* nil)
402. )
403.
« Last Edit: October 06, 2022, 01:34:55 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)  ##### Re: find all possible triangles
« Reply #6 on: June 27, 2022, 11:31:10 PM »
Have anyone founded all possible triangles?
Why should anyone use this for?
So...
Marko Ribar, d.i.a. (graduated engineer of architecture) #### BIGAL

• Swamp Rat
• Posts: 1137
• 40 + years of using Autocad ##### Re: find all possible triangles
« Reply #7 on: June 28, 2022, 09:19:47 PM »
Is this like step 2 you have a lot of points and have labelled them, then why not just use the points and make a TIN it will make 3 sided triangles, can identify points if required look for point XY find txt. Search for TriangV0.6.7.lsp by YMG ##### Re: find all possible triangles
« Reply #8 on: June 29, 2022, 12:30:22 AM »
Is this like step 2 you have a lot of points and have labelled them, then why not just use the points and make a TIN it will make 3 sided triangles, can identify points if required look for point XY find txt. Search for TriangV0.6.7.lsp by YMG

What's your proposed fact despite mentioned code by YMG, for whom we know is not always available or online?... Beside that, the question was posted in order to think more deeply - for elegance of solution we could speak and with Evgeniy and Lee and Didge and Daniel and ... AFAIK...
Marko Ribar, d.i.a. (graduated engineer of architecture)  ##### Re: find all possible triangles
« Reply #9 on: October 17, 2022, 02:27:49 AM »
Not so good, but some advancing happened (usage of my latest template lisp sub function and just some additions to base master code)...

HTH., M.R.
« Last Edit: October 17, 2022, 04:50:53 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture) #### domenicomaria

• Bull Frog
• Posts: 434 ##### Re: find all possible triangles
« Reply #10 on: October 17, 2022, 02:09:02 PM »
ribarm thankyou for your posts !

But the true and full problem is this :

https://www.theswamp.org/index.php?topic=57375.msg608760#msg608760

But i think it is too much complicated !

At least for me !

Maybe the solution could need the collaboration of more gurus . . . ##### Re: find all possible triangles
« Reply #11 on: October 18, 2022, 02:04:55 AM »
@Domenico,

Can I ask you, what do you need more solutions for (if I may)?

Second, if you need solutions, are you seeking for freedom of determination in computerized composition of rational structuring patterns (you have to keep optimal and adequate properties you really consciously find bit being), or something so flexible that you can't neither say this could be good - optimal, or this could be lesser nice (it doesn't have sense and still it process without reflecting questionable need for relief of direct guiding algorithmic reformulation of framed objective visual variability of original existing transmutation)?

For flexibility reasoning, you can imagine that if you have for ex. numeric determination of fixed relations, simple operations of movement could also be realistically accepted, whereas we know for translation and rotation path follow particle rigidity and mirroring/reflection for recomposing duality...
In all of this cases we know that determination of geometric constraints are kept and preserved, but still, for widening of restructuring possibilities, should we decompose to gain variability, we must free some determinant characteristics : from my perspective, I see number of points and number of distances from unknown spacial coordination...
So let's see what we achieve if we add something new, for ex. vertex/point : we actually add relations and still preserve originality in its element basic structure, but we can say for sure that we influenced on level of area (2D) and length/perimeter exponent of curve (2D/3D) so that shaping of structural exponent is changed. Now we know that effect is more fixed predefined formation so that reference structure strive to something cohesively and spatial consuming with more data and geometry assembly that is composed by occupationally pulse live streaming envelope not defined by ancestry physiognomy...
If we subtract something, we for sure loose determination of physiognomy and actually gain freedom of antimatter and spatial superimposition without reflection of desirable symbiotic unity of compositing duality matter/antimatter...

From perspective how should we obtain that something 3rd adjective to physiognomy, cognitively non-determined by dimensional or spacial quality recognition, or just symbolic bit connecting spiritual reference, something as inner feeling, or outer standing direction to combined unity with force balance and controlling predetermination for serve and disposition of goods and sublimation of energy symbiosis of matter, all we can say we are here to comment, consent and give meaning we acknowledge as suitable and harmonic consistent feel for wealthy and heal concerning direction towards ethical or aesthetic appropriate behavior emanation...
What we could know and accept as a correct and complete conclusion to our mindful seeking attitude for answers we strive should bind belief to something that was transferred and left to us at level of our knowledge and brave acting to upper standing concern to rightful and careful taking care of spending prosperity and commitment to greater force of focusing toward something supreme, saint and justified by postulates gained with ethic lawful jurisdiction of trust and concern...
Marko Ribar, d.i.a. (graduated engineer of architecture)  ##### Re: find all possible triangles
« Reply #12 on: October 18, 2022, 04:49:08 AM »
To be honest, I can't get what was expected by my experimental code... IMHO, I think also that this task is solvable in different ways without copy, rotate or mirror... But still, I am unable to get something based on only distances inputs and to be all by myself truthful, I even don't know why I get things that have not even single dimensional matching with reference entity - LWPOLYLINE...
« Last Edit: October 18, 2022, 09:47:57 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)  ##### Re: find all possible triangles
« Reply #13 on: December 24, 2022, 09:11:09 AM »
I think this picture is somewhat wrong : https://www.theswamp.org/index.php?topic=57375.msg608769#msg608769
You should have measured every quad with double triangles crossing at central point - measures goes from central point, then you should have measured another quad - adjacent one with the same procedure and last biggest triangle lower left like you already did it... Make sure all dimensions/lines are inside main polygon and if middle point falls out of area - ray casting algorithm (posted here), then discard that triangle...

Code - Auto/Visual Lisp: [Select]
1. ; Lee Mac Point Inside the Polyline
2. (defun LM:Inside-p ( pt ent / groupbynum lst nrm obj tmp )
3.
4.   (defun groupbynum ( lst n / sub lll )
5.
6.     (defun sub ( m n / ll q )
7.       (cond
8.         ( (and m (< (length m) n))
9.           (repeat (- n (length m))
10.             (setq m (append m (list nil)))
11.           )
12.           (setq ll (vl-remove-if-not (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m))
13.           (setq lll (cons ll lll))
14.           (setq q nil)
15.           (sub (vl-remove-if (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m) n)
16.         )
17.         ( m
18.           (setq ll (vl-remove-if-not (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m))
19.           (setq lll (cons ll lll))
20.           (setq q nil)
21.           (sub (vl-remove-if (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m) n)
22.         )
23.         ( t
24.           (reverse lll)
25.         )
26.       )
27.     )
28.
29.     (sub lst n)
30.   )
31.
32.   (if (= (type ent) 'VLA-OBJECT)
33.     (setq obj ent
34.           ent (vlax-vla-object->ename ent))
35.     (setq obj (vlax-ename->vla-object ent))
36.   )
37.
38.       (setq lst
39.         (groupbynum
40.             (setq tmp
41.               (vlax-ename->vla-object
42.                   (list
43.                     (cons 0 "RAY")
44.                     (cons 100 "AcDbEntity")
45.                     (cons 100 "AcDbRay")
46.                     (cons 10 pt)
47.                     (cons 11 (trans (list 1.0 0.0 0.0) ent 0))
48.                   )
49.                 )
50.               )
51.             )
52.             (quote intersectwith) obj acextendnone
53.           ) 3
54.         )
55.       )
56.       (vla-delete tmp)
57.       (setq nrm (cdr (assoc 210 (entget ent))))
58.       ;; gile:
59.       (and
60.         lst
61.         (not (vlax-curve-getparamatpoint ent pt))
62.         (= 1 (rem (length (vl-remove-if (function (lambda ( p / pa p- p+ p0 )
63.                                                     (setq pa (vlax-curve-getparamatpoint ent p))
64.                                                     (and (setq p- (cond ((setq p- (vlax-curve-getPointatParam ent (- pa 1e-8)))
65.                                                                          (trans p- 0 nrm)
66.                                                                         )
67.                                                                         ((trans (vlax-curve-getPointatParam ent (- (vlax-curve-getEndParam ent) 1e-8)) 0 nrm)
68.                                                                         )
69.                                                                   )
70.                                                          )
71.                                                          (setq p+ (cond ((setq p+ (vlax-curve-getPointatParam ent (+ pa 1e-8)))
72.                                                                          (trans p+ 0 nrm)
73.                                                                         )
74.                                                                         ((trans (vlax-curve-getPointatParam ent (+ (vlax-curve-getStartParam ent) 1e-8)) 0 nrm)
75.                                                                         )
76.                                                                   )
77.                                                          )
78.                                                          (setq p0 (trans pt 0 nrm))
79.                                                          (<= 0 (* (sin (angle p0 p-)) (sin (angle p0 p+)))) ;; LM Mod
80.                                                     )
81.                                                   )
82.                                         ) lst
83.                           )
84.                   ) 2
85.              )
86.         )
87.       )
88.     )
89.     (prompt "\nReference curve isn't planar...")
90.   )
91. )
92.

Note that when assembling you should include that inner point of crossings...
« Last Edit: December 29, 2022, 06:52:09 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)   