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

0 Members and 1 Guest are viewing this topic.

#### domenicomaria

• Bull Frog
• Posts: 430
##### 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: 430
##### 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 »

#### ribarm

• Gator
• Posts: 2864
• Marko Ribar, architect
##### 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)

M.R. on Youtube

#### domenicomaria

• Bull Frog
• Posts: 430
##### 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).

I will read, study and test your code very carefully.

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

Thanks a lot anyway.

Ciao

#### ribarm

• Gator
• Posts: 2864
• Marko Ribar, architect
##### 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)

M.R. on Youtube

#### ribarm

• Gator
• Posts: 2864
• Marko Ribar, architect
##### 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.
8.   (vl-load-com) ;;; load ActiveX extensions (VLA functions) ;;;
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))
80.             (= (cadr edge) (cadr 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))
96.                 (vl-position (cadr edge) (cadr 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)))
140.     (setq q (ci1xci2 p1 (caddr (caddr tr)) p2 (caddr (cadr 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))
172.             (setq te (list (cadr te) (caddr te) (car te)))
173.           )
174.           (cond
175.             ( (equal ed (caddr (cadr tr)) 1e-6)
176.               (setq ll (cons (list te p3 (angle p3 p2)) ll))
177.             )
178.             ( (equal ed (caddr (caddr tr)) 1e-6)
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.       )
202.       (processtr (car tr) (cadr tr) (caddr tr))
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
318.               (> (caddar tr) (caddr (cadr tr)))
319.               (> (caddar tr) (caddr (caddr tr)))
320.             )
321.           )
322.           (setq tr (list (cadr tr) (caddr tr) (car tr)))
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.           )
339.           (setq ss (ssadd))
340.           (foreach reg regs
341.             (ssadd reg ss)
342.           )
343.           (vl-cmdf "_.union" ss "")
344.           (if
345.             (setq regs
346.               (vl-remove-if (function vlax-erased-p) regs)
347.             )
348.             (if (not (cadr regs))
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)

M.R. on Youtube

#### ribarm

• Gator
• Posts: 2864
• Marko Ribar, architect
##### 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)

M.R. on Youtube

#### BIGAL

• Swamp Rat
• Posts: 1128
• 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
A man who never made a mistake never made anything

#### ribarm

• Gator
• Posts: 2864
• Marko Ribar, architect
##### 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)

M.R. on Youtube

#### ribarm

• Gator
• Posts: 2864
• Marko Ribar, architect
##### 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)

M.R. on Youtube

#### domenicomaria

• Bull Frog
• Posts: 430
##### 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 . . .

#### ribarm

• Gator
• Posts: 2864
• Marko Ribar, architect
##### 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)

M.R. on Youtube

#### ribarm

• Gator
• Posts: 2864
• Marko Ribar, architect
##### 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)

M.R. on Youtube

#### ribarm

• Gator
• Posts: 2864
• Marko Ribar, architect
##### 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)

M.R. on Youtube

#### ribarm

• Gator
• Posts: 2864
• Marko Ribar, architect
##### Re: find all possible triangles
« Reply #14 on: December 27, 2022, 12:23:20 PM »
Maybe flips of quadrilaterals with perhaps case like this...
Look at picture...
Marko Ribar, d.i.a. (graduated engineer of architecture)

M.R. on Youtube

#### domenicomaria

• Bull Frog
• Posts: 430
##### Re: find all possible triangles
« Reply #15 on: December 27, 2022, 01:37:51 PM »
Marco
I have a health problem
And I'm in the hospital

And I can't study your code and give you an answer

Further on, I hope I can.

Thank you

Ciao

#### ribarm

• Gator
• Posts: 2864
• Marko Ribar, architect
##### Re: find all possible triangles
« Reply #16 on: December 27, 2022, 03:18:40 PM »
Sorry for health Domenico...
I believe that something hides behind this code, but it doesn't modify copied polylines... Don't know how to fix it...

[EDIT : Fixed buggs...]

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* tttt uniquetrl comb trianglst LM:popup makelw mid
5.                                        lw lwn lwx pl dx dd plcomb trl p3 tr k wcs ti
6.                                    )
7.
8.   (defun *error* ( m )
9.     (if wcs
10.       (if ucsf
11.         (exe (list "_.UCS" "_P"))
12.       )
13.     )
14.     (while (= 8 (logand 8 (getvar (quote undoctl))))
15.       (if (not (exe (list "_.UNDO" "_E")))
16.         (if doc
17.           (vla-endundomark doc)
18.         )
19.       )
20.     )
21.     (if initvalueslst
22.       (mapcar (function apply_cadr->car) initvalueslst)
23.     )
24.     (foreach fun (list (quote tttt) (quote vl-load) (quote exe) (quote cmdfun) (quote cmderr) (quote catch_cont) (quote apply_cadr->car) (quote ftoa))
25.       (setq fun nil)
26.     )
27.     (if doc
28.       (vla-regen doc acactiveviewport)
29.     )
30.     (if m
31.       (prompt m)
32.     )
33.     (princ)
34.   )
35.
36.   (defun tttt ( wcs / sysvarpreset sysvarlst sysvarvals ) ;;; wcs (T/nil) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;; vl-load exe cmdfun cmderr catch_cont apply_cadr->car ftoa - library sub functions common for standard template initialization ;;;
37.
38.     (defun vl-load nil
39.       (or cad
40.           (setq cad (vlax-get-acad-object))
41.             (setq cad (vlax-get-acad-object))
42.           )
43.         )
44.       )
45.       (or doc (setq doc (vla-get-activedocument cad)))
46.       (or alo (setq alo (vla-get-activelayout doc)))
47.       (or spc (setq spc (vla-get-block alo)))
48.     )
49.
50.     ;;; sometimes not needed to use/initialize AxiveX Visual Lisp extensions - (comment/uncomment) following line ;;;
51.     (or (and cad doc alo spc) (vl-load))
52.
53.     (defun exe ( tokenslist )
54.       ( (lambda ( tokenslist / ctch )
55.           (if (vl-catch-all-error-p (setq ctch (cmdfun tokenslist t)))
56.               (cmderr tokenslist)
57.               (catch_cont ctch)
58.             )
59.               (while (< 0 (getvar (quote cmdactive)))
60.                 (vl-cmdf "")
61.               )
62.               t
63.             )
64.           )
65.         )
66.         tokenslist
67.       )
68.     )
69.
70.     (defun cmdfun ( tokenslist flag / ctch ) ;;; tokenslist - command parameters list of strings ;;; flag - if "t" specified, upon successful execution returns t, otherwise if "nil" specified, return is always nil no matter what outcome of function execution is - it should be successful anyway if specified tokenslist was hardcoded correctly... ;;;
71.       (if command-s
72.         (if flag
73.           (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist))))
74.             flag
75.             ctch
76.           )
77.           (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist)))
78.             ctch
79.           )
80.         )
81.         (if flag
82.           (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function vl-cmdf) tokenslist))))
83.             flag
84.             ctch
85.           )
86.           (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command) tokenslist)))
87.             ctch
88.           )
89.         )
90.       )
91.     )
92.
93.     (defun cmderr ( tokenslist ) ;;; tokenslist - list of tokens representing command syntax at which used (cmdfun) failed with successful execution ;;;
94.       (prompt (strcat "\ncommand execution failure... error at used command tokenslist : " (vl-prin1-to-string tokenslist)))
95.     )
96.
97.     (defun catch_cont ( ctch / gr )
98.       (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...")
99.         (and
100.           (vl-catch-all-error-p (or ctch (setq ctch (vl-catch-all-apply (function /) (list 1 0)))))
101.           (setq gr (grread))
102.           (/= (car gr) 3)
103.           (not (equal gr (list 2 13)))
104.         )
105.       )
106.       (if (vl-catch-all-error-p ctch)
107.         ctch
108.       )
109.     )
110.
111.     (defun apply_cadr->car ( sysvarvaluepair / ctch )
112.       (setq ctch (vl-catch-all-apply (function setvar) sysvarvaluepair))
113.       (if (vl-catch-all-error-p ctch)
114.           (prompt (strcat "\ncatched error on setting system variable : " (vl-prin1-to-string (vl-symbol-name (car sysvarvaluepair))) " with value : " (vl-prin1-to-string (cadr sysvarvaluepair))))
115.           (catch_cont ctch)
116.         )
117.       )
118.     )
119.
120.     (defun ftoa ( n / m a s b )
121.       (if (numberp n)
122.           (setq m (fix ((if (< n 0) - +) n 1e-8)))
123.           (setq a (abs (- n m)))
124.           (setq m (itoa m))
125.           (setq s "")
126.           (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0))))
127.             (setq s (strcat s (itoa b)))
128.             (setq a (- (* a 10.0) b))
129.           )
130.           (if (= (type n) (quote int))
131.             m
132.             (if (= s "")
133.               m
134.               (if (and (= m "0") (< n 0))
135.                 (strcat "-" m "." s)
136.                 (strcat m "." s)
137.               )
138.             )
139.           )
140.         )
141.       )
142.     )
143.
144.     (setq sysvarpreset
145.       (list
146.         (list (quote cmdecho) 0)
147.         (list (quote 3dosmode) 0)
148.         (list (quote osmode) 0)
149.         (list (quote unitmode) 0)
150.         (list (quote cmddia) 0)
151.         (list (quote ucsvp) 0)
152.         (list (quote ucsortho) 0)
153.         (list (quote projmode) 0)
154.         (list (quote orbitautotarget) 0)
155.         (list (quote insunits) 0)
156.         (list (quote hpseparate) 0)
157.         (list (quote hpgaptol) 0)
158.         (list (quote halogap) 0)
159.         (list (quote edgemode) 0)
160.         (list (quote pickdrag) 0)
161.         (list (quote qtextmode) 0)
162.         (list (quote dragsnap) 0)
163.         (list (quote angdir) 0)
164.         (list (quote aunits) 0)
165.         (list (quote limcheck) 0)
166.         (list (quote gridmode) 0)
167.         (list (quote nomutt) 0)
168.         (list (quote apbox) 0)
169.         (list (quote attdia) 0)
170.         (list (quote blipmode) 0)
171.         (list (quote copymode) 0)
172.         (list (quote circlerad) 0.0)
173.         (list (quote filletrad) 0.0)
174.         (list (quote filedia) 1)
175.         (list (quote autosnap) 1)
176.         (list (quote objectisolationmode) 1)
177.         (list (quote highlight) 1)
178.         (list (quote lispinit) 1)
179.         (list (quote layerpmode) 1)
180.         (list (quote fillmode) 1)
181.         (list (quote dragmodeinterrupt) 1)
182.         (list (quote dispsilh) 1)
183.         (list (quote fielddisplay) 1)
184.         (list (quote deletetool) 1)
185.         (list (quote delobj) 1)
186.         (list (quote dblclkedit) 1)
187.         (list (quote attreq) 1)
188.         (list (quote explmode) 1)
189.         (list (quote frameselection) 1)
190.         (list (quote ltgapselection) 1)
191.         (list (quote pickfirst) 1)
192.         (list (quote plinegen) 1)
193.         (list (quote plinetype) 1)
194.         (list (quote peditaccept) 1)
195.         (list (quote solidcheck) 1)
196.         (list (quote visretain) 1)
197.         (list (quote regenmode) 1)
198.         (list (quote celtscale) 1.0)
199.         (list (quote ltscale) 1.0)
200.         (list (quote osnapcoord) 2)
201.         (list (quote grips) 2)
202.         (list (quote dragmode) 2)
203.         (list (quote lunits) 2)
204.         (list (quote pickstyle) 3)
205.         (list (quote navvcubedisplay) 3)
206.         (list (quote pickauto) 3)
207.         (list (quote draworderctl) 3)
208.         (list (quote expert) 5)
209.         (list (quote auprec) 6)
210.         (list (quote luprec) 6)
211.         (list (quote pickbox) 6)
212.         (list (quote aperture) 6)
213.         (list (quote osoptions) 7)
214.         (list (quote dimzin) 8)
215.         (list (quote pdmode) 35)
216.         (list (quote pdsize) -1.5)
217.         (list (quote celweight) -1)
218.         (list (quote cecolor) "BYLAYER")
219.         (list (quote celtype) "ByLayer")
220.         (list (quote clayer) "0")
221.       )
222.     )
223.     (setq sysvarlst (mapcar (function car) sysvarpreset))
224.     (setq sysvarvals (mapcar (function cadr) sysvarpreset))
225.     (setq sysvarvals
226.       (vl-remove nil
227.           (function (lambda ( x )
228.             (if (getvar x) (nth (vl-position x sysvarlst) sysvarvals))
229.           ))
230.           sysvarlst
231.         )
232.       )
233.     )
234.     (setq sysvarlst
235.       (vl-remove-if-not
236.         (function (lambda ( x )
237.           (getvar x)
238.         ))
239.         sysvarlst
240.       )
241.     )
242.     (setq initvalueslst
243.           (list
244.             sysvarlst
245.             (mapcar (function getvar) sysvarlst)
246.           )
247.         )
248.       )
249.     )
250.         (list
251.           sysvarlst
252.           sysvarvals
253.         )
254.       )
255.     )
256.     (while (= 8 (logand 8 (getvar (quote undoctl))))
257.       (if (not (exe (list "_.UNDO" "_E")))
258.         (if doc
259.           (vla-endundomark doc)
260.         )
261.       )
262.     )
263.     (if (not (exe (list "_.UNDO" "_M")))
264.       (if doc
265.         (vla-startundomark doc)
266.       )
267.     )
268.     (if wcs
269.       (if (= 0 (getvar (quote worlducs)))
270.           (exe (list "_.UCS" "_W"))
271.           (setq ucsf t)
272.         )
273.       )
274.     )
275.     wcs
276.   )
277.
278.   (defun uniquetrl ( trl )
279.     (if trl
280.       (cons (car trl)
281.         (uniquetrl
282.           (vl-remove-if
283.             (function (lambda ( x )
284.                 (function (lambda ( y )
285.                     (function (lambda ( z ) (equal y z 1e-6)))
286.                     (car trl)
287.                   )
288.                 ))
289.                 x
290.               )
291.             ))
292.             (cdr trl)
293.           )
294.         )
295.       )
296.     )
297.   )
298.
299.   (defun comb ( lst / ll r )
300.     (setq ll lst)
301.     (foreach i1 lst
302.       (setq lst (cdr lst))
303.       (foreach i2 lst
304.         (setq r
305.           (cons
306.             (list
307.               i1
308.               i2
309.               (distance i1 i2)
310.             )
311.             r
312.           )
313.         )
314.       )
315.     )
316.     r
317.   )
318.
319.   (defun trianglst ( plcomb / ll trl r )
320.     (setq ll plcomb)
321.     (foreach edge plcomb
322.       (setq plcomb (cdr plcomb))
323.       (foreach next plcomb
324.         (if
325.           (or
326.             (= (car edge) (car next))
327.             (= (car edge) (cadr next))
328.             (= (cadr edge) (car next))
329.             (= (cadr edge) (cadr next))
330.           )
331.           (setq trl
332.             (cons (list edge next) trl)
333.           )
334.         )
335.       )
336.     )
337.     (setq plcomb ll)
338.     (foreach 2edges trl
339.       (foreach edge plcomb
340.         (if
341.           (and
342.             (or
343.               (and
344.                 (vl-position (car edge) (car 2edges))
345.                 (vl-position (cadr edge) (cadr 2edges))
346.               )
347.               (and
348.                 (vl-position (car edge) (cadr 2edges))
349.                 (vl-position (cadr edge) (car 2edges))
350.               )
351.             )
352.             (not (vl-position edge 2edges))
353.           )
354.           (setq r
355.             (cons
356.               (append 2edges (list edge))
357.               r
358.             )
359.           )
360.         )
361.       )
362.     )
363.     r
364.   )
365.
366.   ;; Popup  -  Lee Mac
367.   ;; A wrapper for the WSH popup method to display a message box prompting the user.
368.   ;; ttl - [str] Text to be displayed in the pop-up title bar
369.   ;; msg - [str] Text content of the message box
370.   ;; bit - [int] Bit-coded integer indicating icon & button appearance
371.   ;; Returns: [int] Integer indicating the button pressed to exit
372.
373.   (defun LM:popup ( ttl msg bit / wsh rtn )
374.     (if (setq wsh (vlax-create-object "wscript.shell"))
375.         (setq rtn
376.           (vl-catch-all-apply (function vlax-invoke-method)
377.             (list wsh (quote popup) msg 0 ttl bit)
378.           )
379.         )
380.         (vlax-release-object wsh)
381.         (if (not (vl-catch-all-error-p rtn)) rtn)
382.       )
383.     )
384.   )
385.
386.   (defun makelw ( pl ocs elev )
387.         (list
388.           (cons 0 "LWPOLYLINE")
389.           (cons 100 "AcDbEntity")
390.           (cons 100 "AcDbPolyline")
391.           (cons 90 (length pl))
392.           (cons 70 (1+ (* 128 (getvar (quote plinegen)))))
393.           (cons 38 elev)
394.         )
395.         (mapcar (function (lambda ( p ) (cons 10 p))) pl)
396.         (list (cons 210 ocs))
397.       )
398.     )
399.   )
400.
401.   (defun mid ( p1 p2 )
402.     (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) p1 p2)
403.   )
404.
405.   (setq wcs (tttt t)) ;;; INITIALIZATION OF PRESET SUB FUNCTIONS AND SYSTEM VARIABLE SETTINGS ;;;
406.   (if
407.     (or
408.       (not (setq lw (car (entsel "\nPick closed polygonal LWPOLYLINE..."))))
409.       (and
410.         lw
411.         (= (cdr (assoc 0 (setq lwx (entget lw)))) "LWPOLYLINE")
412.         (= 1 (logand 1 (cdr (assoc 70 lwx))))
413.             (vl-remove-if
414.               (function (lambda ( x )
415.                 (/= (car x) 42)
416.               ))
417.               lwx
418.             )
419.           )
420.         )
421.       )
422.     )
423.       (setq ti (car (_vl-times)))
424.       (prompt "\nSource LWPOLYLINE length : ") (prompt (ftoa (vla-get-length (vlax-ename->vla-object lw))))
425.       (setq ocs (cdr (assoc 210 lwx)))
426.       (setq elev (cdr (assoc 38 lwx)))
427.       (exe (list "_.UCS" "_ZA" "_non" (list 0.0 0.0 0.0) "_non" ocs))
428.       (exe (list "_.UCS" "_M" "_non" (list 0.0 0.0 elev)))
429.       (setq pl
430.           (vl-remove-if
431.             (function (lambda ( x )
432.               (/= (car x) 10)
433.             ))
434.             lwx
435.           )
436.         )
437.       )
438.       (setq dx (- (apply (function max) (mapcar (function car) pl)) (apply (function min) (mapcar (function car) pl))))
439.       (setq plcomb (comb pl))
440.       (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)) ... ) ;;;
441.       ;;; (princ trl) ;;;
442.       ;;; ... we are here with triangles ... ;;;
443.       ;;; 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 ; ... ;;;
444.       ;;; Order goes like this : 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ... ;;;
445.       (setq k 0)
446.       (if (> (cdr (assoc 90 lwx)) 3)
447.         (repeat (length trl)
448.           (exe (list "_.COPY" (ssadd lw) "" "_non" (list 0.0 0.0 0.0) "_non" (list (setq dd (* dx (setq k (1+ k)))) 0.0 0.0)))
449.           (setq lwx (entget (entupd (setq lwn (entlast)))))
450.           (setq pl
451.               (vl-remove-if
452.                 (function (lambda ( x )
453.                   (/= (car x) 10)
454.                 ))
455.                 lwx
456.               )
457.             )
458.           )
459.           (setq tr (nth (1- k) trl))
460.           (setq tr
461.             (list
462.               (list (list (+ dd (nth 0 (nth 0 (nth 0 tr)))) (nth 1 (nth 0 (nth 0 tr)))) (list (+ dd (nth 0 (nth 1 (nth 0 tr)))) (nth 1 (nth 1 (nth 0 tr)))) (nth 2 (nth 0 tr)))
463.               (list (list (+ dd (nth 0 (nth 0 (nth 1 tr)))) (nth 1 (nth 0 (nth 1 tr)))) (list (+ dd (nth 0 (nth 1 (nth 1 tr)))) (nth 1 (nth 1 (nth 1 tr)))) (nth 2 (nth 1 tr)))
464.               (list (list (+ dd (nth 0 (nth 0 (nth 2 tr)))) (nth 1 (nth 0 (nth 2 tr)))) (list (+ dd (nth 0 (nth 1 (nth 2 tr)))) (nth 1 (nth 1 (nth 2 tr)))) (nth 2 (nth 2 tr)))
465.             )
466.           )
467.           (cond
468.             ( (not (equal (mapcar (function +) (list 0.0 0.0) (vlax-curve-getclosestpointto lwn (mid (nth 0 (nth 0 tr)) (nth 1 (nth 0 tr))))) (mid (nth 0 (nth 0 tr)) (nth 1 (nth 0 tr))) 1e-6))
469.               (setq li (entmakex (list (cons 0 "LINE") (cons 10 (nth 0 (nth 0 tr))) (cons 11 (nth 1 (nth 0 tr))))))
470.               (setq p3 (mapcar (function +) (vlax-curve-getclosestpointto li (nth 0 (nth 2 tr)) t) (mapcar (function -) (vlax-curve-getclosestpointto li (nth 0 (nth 2 tr)) t) (nth 0 (nth 2 tr)))))
471.               (setq pl (mapcar (function (lambda ( x ) (if (equal (nth 0 (nth 2 tr)) x 1e-6) (list (car p3) (cadr p3)) x))) pl))
472.               (makelw pl ocs elev)
473.             )
474.             ( (not (equal (mapcar (function +) (list 0.0 0.0) (vlax-curve-getclosestpointto lwn (mid (nth 0 (nth 1 tr)) (nth 1 (nth 1 tr))))) (mid (nth 0 (nth 1 tr)) (nth 1 (nth 1 tr))) 1e-6))
475.               (setq li (entmakex (list (cons 0 "LINE") (cons 10 (nth 0 (nth 1 tr))) (cons 11 (nth 1 (nth 1 tr))))))
476.               (setq p3 (mapcar (function +) (vlax-curve-getclosestpointto li (nth 0 (nth 0 tr)) t) (mapcar (function -) (vlax-curve-getclosestpointto li (nth 0 (nth 0 tr)) t) (nth 0 (nth 0 tr)))))
477.               (setq pl (mapcar (function (lambda ( x ) (if (equal (nth 0 (nth 0 tr)) x 1e-6) (list (car p3) (cadr p3)) x))) pl))
478.               (makelw pl ocs elev)
479.             )
480.             ( (not (equal (mapcar (function +) (list 0.0 0.0) (vlax-curve-getclosestpointto lwn (mid (nth 0 (nth 2 tr)) (nth 1 (nth 2 tr))))) (mid (nth 0 (nth 2 tr)) (nth 1 (nth 2 tr))) 1e-6))
481.               (setq li (entmakex (list (cons 0 "LINE") (cons 10 (nth 0 (nth 2 tr))) (cons 11 (nth 1 (nth 2 tr))))))
482.               (setq p3 (mapcar (function +) (vlax-curve-getclosestpointto li (nth 0 (nth 1 tr)) t) (mapcar (function -) (vlax-curve-getclosestpointto li (nth 0 (nth 1 tr)) t) (nth 0 (nth 1 tr)))))
483.               (setq pl (mapcar (function (lambda ( x ) (if (equal (nth 0 (nth 1 tr)) x 1e-6) (list (car p3) (cadr p3)) x))) pl))
484.               (makelw pl ocs elev)
485.             )
486.           )
487.           (if (and li (not (vlax-erased-p li)))
488.             (entdel li)
489.           )
490.           (if (and lwn (not (vlax-erased-p lwn)))
491.             (entdel lwn)
492.           )
493.         )
494.       )
495.       (repeat 2
496.         (exe (list "_.UCS" "_P"))
497.       )
498.       (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...")
499.       (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
500.     )
501.       (prompt "\nMissed..., or picked wrong entity type, or picked LWPOLYLINE not closed, or picked LWPOLYLINE not polygonal - has arced segments...")
502.       (if (= 4 (LM:popup "DECOMPOSITION+COMPOSITION - IRREGULAR POLYGON" "Choose option : " 53))
503.         (c:decomposition+composition)
504.       )
505.     )
506.   )
507.   (*error* nil)
508. )
509.

M.R.
« Last Edit: December 29, 2022, 10:06:43 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

M.R. on Youtube

#### ribarm

• Gator
• Posts: 2864
• Marko Ribar, architect
##### Re: find all possible triangles
« Reply #17 on: December 29, 2022, 10:08:22 AM »
I've debugged it more further... So I ended with this picture... LSP attached to this post... Thanks for attention...
Marko Ribar, d.i.a. (graduated engineer of architecture)

M.R. on Youtube

#### ribarm

• Gator
• Posts: 2864
• Marko Ribar, architect
##### Re: find all possible triangles
« Reply #18 on: January 15, 2023, 12:54:14 PM »
Here is another revision... But it's buggy - maybe you'll get only one or few triangles, but complete structure I doubt you'll get...

M.R.
« Last Edit: January 16, 2023, 10:26:50 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

M.R. on Youtube

#### ribarm

• Gator
• Posts: 2864
• Marko Ribar, architect
##### Re: find all possible triangles
« Reply #19 on: January 16, 2023, 11:33:24 AM »
I've just throwed triangles and tried to compose broken pieces... Evgeniy had once this solved - I think that this was the topic, but not 100% sure... See if you can find something relevant to this issue : https://www.theswamp.org/index.php?topic=44783.0
Only thing was that pieces should not have been rotated, or mirrored - so throwing all still not good approach...

HTH.
M.R.
« Last Edit: January 19, 2023, 03:30:06 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

M.R. on Youtube

#### ribarm

• Gator
• Posts: 2864
• Marko Ribar, architect
##### Re: find all possible triangles
« Reply #20 on: January 17, 2023, 04:57:36 AM »
decomposition+composition-inside-p.lsp gives the most adequate results... So I think that without ANGLES as additional parameter, it is almost impossible to solve this task... I've implemented angles and (jigsaw) sub, so it works the most appropriate - with convex shapes, it should never fail to copy original shape...

[EDIT] This file in attachment yields convex hull of picked polygonal LWPOLYLINE... [/EDIT]
« Last Edit: January 19, 2023, 03:29:48 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

M.R. on Youtube