Author Topic: find all possible triangles  (Read 3959 times)

0 Members and 1 Guest are viewing this topic.

domenicomaria

  • Swamp Rat
  • Posts: 723
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

  • Swamp Rat
  • Posts: 723
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: 3225
  • 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.       (progn
  61.         (setq rtn (vl-catch-all-apply 'vlax-invoke-method (list wsh 'popup msg 0 ttl bit)))
  62.         (vlax-release-object wsh)
  63.         (if (not (vl-catch-all-error-p rtn)) rtn)
  64.       )
  65.     )
  66.   )
  67.  
  68.   (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)))))
  69.     (progn
  70.       (setq pl (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) lwx)))
  71.       (setq plcomb (comb pl))
  72.       (princ (setq trl (uniquetrl (trianglst plcomb))))
  73.       ;;; ... we are here with triangles ... ;;;
  74.       (textscr)
  75.     )
  76.     (progn
  77.       (prompt "\nMissed..., or picked wrong entity type, or picked LWPOLYLINE not closed, or picked LWPOLYLINE not polygonal - has arced segments...")
  78.       (if (= 4 (LM:popup "DECOMPOSITION+COMPOSITION - IRREGULAR POLYGON" "Choose option : " 53))
  79.         (c:decomposition+composition)
  80.       )
  81.     )
  82.   )
  83.   (princ)
  84. )
  85.  
« 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

  • Swamp Rat
  • Posts: 723
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: 3225
  • 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: 3225
  • 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.               (vl-every
  36.                 (function (lambda ( y )
  37.                   (vl-some
  38.                     (function (lambda ( z ) (equal y z 1e-6)))
  39.                     (car trl)
  40.                   )
  41.                 ))
  42.                 x
  43.               )
  44.             ))
  45.             (cdr trl)
  46.           )
  47.         )
  48.       )
  49.     )
  50.   )
  51.  
  52.   (defun comb ( lst / ll r )
  53.     (setq ll lst)
  54.     (foreach i1 lst
  55.       (setq lst (cdr lst))
  56.       (foreach i2 lst
  57.         (setq r
  58.           (cons
  59.             (list
  60.               (vl-position i1 ll)
  61.               (vl-position i2 ll)
  62.               (distance i1 i2)
  63.             )
  64.             r
  65.           )
  66.         )
  67.       )
  68.     )
  69.     r
  70.   )
  71.  
  72.   (defun trianglst ( plcomb / ll trl r )
  73.     (setq ll plcomb)
  74.     (foreach edge plcomb
  75.       (setq plcomb (cdr plcomb))
  76.       (foreach next plcomb
  77.         (if
  78.           (or
  79.             (= (car edge) (car next))
  80.             (= (car edge) (cadr next))
  81.             (= (cadr edge) (car next))
  82.             (= (cadr edge) (cadr next))
  83.           )
  84.           (setq trl
  85.             (cons (list edge next) trl)
  86.           )
  87.         )
  88.       )
  89.     )
  90.     (setq plcomb ll)
  91.     (foreach 2edges trl
  92.       (foreach edge plcomb
  93.         (if
  94.           (and
  95.             (or
  96.               (and
  97.                 (vl-position (car edge) (car 2edges))
  98.                 (vl-position (cadr edge) (cadr 2edges))
  99.               )
  100.               (and
  101.                 (vl-position (car edge) (cadr 2edges))
  102.                 (vl-position (cadr edge) (car 2edges))
  103.               )
  104.             )
  105.             (not (vl-position edge 2edges))
  106.           )
  107.           (setq r
  108.             (cons
  109.               (append 2edges (list edge))
  110.               r
  111.             )
  112.           )
  113.         )
  114.       )
  115.     )
  116.     r
  117.   )
  118.  
  119.   ;; Popup  -  Lee Mac
  120.   ;; A wrapper for the WSH popup method to display a message box prompting the user.
  121.   ;; ttl - [str] Text to be displayed in the pop-up title bar
  122.   ;; msg - [str] Text content of the message box
  123.   ;; bit - [int] Bit-coded integer indicating icon & button appearance
  124.   ;; Returns: [int] Integer indicating the button pressed to exit
  125.  
  126.   (defun LM:popup ( ttl msg bit / wsh rtn )
  127.     (if (setq wsh (vlax-create-object "wscript.shell"))
  128.       (progn
  129.         (setq rtn
  130.           (vl-catch-all-apply (function vlax-invoke-method)
  131.             (list wsh (quote popup) msg 0 ttl bit)
  132.           )
  133.         )
  134.         (vlax-release-object wsh)
  135.         (if (not (vl-catch-all-error-p rtn)) rtn)
  136.       )
  137.     )
  138.   )
  139.  
  140.   (defun processtr ( tr p ang / p1 p2 p3 q edl tre ll )
  141.     (setq p1 p)
  142.     (setq p2 (polar p ang (caddar tr)))
  143.     (setq q (ci1xci2 p1 (caddr (caddr tr)) p2 (caddr (cadr tr))))
  144.     (foreach p3 q
  145.       (if (and p1 p2 p3)
  146.         (setq lws
  147.           (cons
  148.             (makelwtr p1 p2 p3)
  149.             lws
  150.           )
  151.         )
  152.       )
  153.       (setq edl
  154.         (list
  155.           (distance p2 p3)
  156.           (distance p3 p1)
  157.         )
  158.       )
  159.       (setq trl (vl-remove tr trl))
  160.       (foreach ed edl
  161.         (setq tre
  162.           (vl-remove-if-not
  163.             (function (lambda ( x )
  164.               (vl-some
  165.                 (function (lambda ( y )
  166.                   (equal ed (caddr y) 1e-6)
  167.                 ))
  168.                 x
  169.               )
  170.             ))
  171.             trl
  172.           )
  173.         )
  174.         (foreach te tre
  175.           (while (not (equal ed (caddar te) 1e-6))
  176.             (setq te (list (cadr te) (caddr te) (car te)))
  177.           )
  178.           (cond
  179.             ( (equal ed (caddr (cadr tr)) 1e-6)
  180.               (setq ll (cons (list te p3 (angle p3 p2)) ll))
  181.             )
  182.             ( (equal ed (caddr (caddr tr)) 1e-6)
  183.               (setq ll (cons (list te p3 (angle p3 p1)) ll))
  184.             )
  185.           )
  186.         )
  187.       )
  188.     )
  189.     (foreach tr ll
  190.       (setq trl
  191.         (vl-remove-if
  192.           (function (lambda ( x )
  193.             (vl-every
  194.               (function (lambda ( y )
  195.                 (vl-some
  196.                   (function (lambda ( z )
  197.                     (equal y z 1e-6)
  198.                   ))
  199.                   (car tr)
  200.                 )
  201.               ))
  202.               x
  203.             )
  204.           ))
  205.           trl
  206.         )
  207.       )
  208.       (processtr (car tr) (cadr tr) (caddr tr))
  209.     )
  210.   )
  211.  
  212.   (defun makelwtr ( p1 p2 p3 )
  213.     (entmakex
  214.       (list
  215.         (cons 0 "LWPOLYLINE")
  216.         (cons 100 "AcDbEntity")
  217.         (cons 100 "AcDbPolyline")
  218.         (cons 90 3)
  219.         (cons 70 (1+ (* 128 (getvar (quote plinegen)))))
  220.         (cons 38 0.0)
  221.         (cons 10 p1)
  222.         (cons 10 p2)
  223.         (cons 10 p3)
  224.         (list 210 0.0 0.0 1.0)
  225.       )
  226.     )
  227.   )
  228.  
  229.   ;; 2-Circle Intersection (trans version)  -  Lee Mac
  230.   ;; Returns the point(s) of intersection between two circles
  231.   ;; with centres c1,c2 and radii r1,r2
  232.  
  233.   (defun ci1xci2 ( c1 r1 c2 r2 / n d1 x z )
  234.     (if
  235.       (and
  236.         (or
  237.           (< (setq d1 (distance c1 c2)) (+ r1 r2))
  238.           (equal d1 (+ r1 r2) 1e-6)
  239.         )
  240.         (or
  241.           (< (abs (- r1 r2)) d1)
  242.           (equal (abs (- r1 r2)) d1 1e-6)
  243.         )
  244.       )
  245.       (progn
  246.         (setq n (mapcar (function -) c2 c1))
  247.         (setq c1 (trans c1 0 n))
  248.         (setq z (abs (/ (- (+ (* r1 r1) (* d1 d1)) (* r2 r2)) (+ d1 d1))))
  249.         (if (equal z r1 1e-6)
  250.           (list (trans (list (car c1) (cadr c1) (+ (caddr c1) z)) n 0))
  251.           (progn
  252.             (setq x (sqrt (- (* r1 r1) (* z z))))
  253.             (list
  254.               (trans (list (- (car c1) x) (cadr c1) (+ (caddr c1) z)) n 0)
  255.               (trans (list (+ (car c1) x) (cadr c1) (+ (caddr c1) z)) n 0)
  256.             )
  257.           )
  258.         )
  259.       )
  260.     )
  261.   )
  262.  
  263.   (setq cmd (getvar (quote cmdecho)))
  264.   (setvar (quote cmdecho) 0)
  265.   (setq pea (getvar (quote peditaccept)))
  266.   (setvar (quote peditaccept) 1)
  267.   (if (= 8 (logand 8 (getvar (quote undoctl))))
  268.     (if command-s
  269.       (command-s "_.undo" "_e")
  270.       (vl-cmdf "_.undo" "_e")
  271.     )
  272.   )
  273.   (if command-s
  274.     (command-s "_.undo" "_m")
  275.     (vl-cmdf "_.undo" "_m")
  276.   )
  277.   (if
  278.     (or
  279.       (not (setq lw (car (entsel "\nPick closed polygonal LWPOLYLINE..."))))
  280.       (and
  281.         lw
  282.         (= (cdr (assoc 0 (setq lwx (entget lw)))) "LWPOLYLINE")
  283.         (= 1 (logand 1 (cdr (assoc 70 lwx))))
  284.         (vl-every (function zerop)
  285.           (mapcar (function cdr)
  286.             (vl-remove-if
  287.               (function (lambda ( x )
  288.                 (/= (car x) 42)
  289.               ))
  290.               lwx
  291.             )
  292.           )
  293.         )
  294.       )
  295.     )
  296.     (progn
  297.       (setq pl
  298.         (mapcar (function cdr)
  299.           (vl-remove-if
  300.             (function (lambda ( x )
  301.               (/= (car x) 10)
  302.             ))
  303.             lwx
  304.           )
  305.         )
  306.       )
  307.       (setq plcomb (comb pl))
  308.       (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)) ... )
  309.       ;;; (princ trl) ;;;
  310.       ;;; ... we are here with triangles ... ;;;
  311.       ;;; 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 ; ...
  312.       ;;; Order goes like this : 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...
  313.       (setq edgesl (vl-sort (apply (function append) trl) (function (lambda ( a b ) (> (caddr a) (caddr b)))))) ;;; edges sorted from longest to shortest ;;;
  314.       (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 ;;;
  315.       (initget 1)
  316.       (setq p (getpoint "\nPick point : "))
  317.       (while
  318.         (and
  319.           trl
  320.           (not (setq chk (equal tr (car trl) 1e-6)))
  321.           (setq tr (car trl))
  322.         )
  323.         (if chk
  324.           (progn
  325.             (prompt "\nLooping haven't passed correctly - some triangles from list trl haven't been processed...")
  326.             (if (/= 6 (LM:popup "CONTINUE WITH PROCESSING - YES / QUIT - NO" "Choose option : " 36))
  327.               (exit)
  328.             )
  329.           )
  330.         )
  331.         (while
  332.           (not
  333.             (and
  334.               (> (caddar tr) (caddr (cadr tr)))
  335.               (> (caddar tr) (caddr (caddr tr)))
  336.             )
  337.           )
  338.           (setq tr (list (cadr tr) (caddr tr) (car tr)))
  339.         )
  340.         (processtr tr p 0.0)
  341.       )
  342.       (if (= 6 (LM:popup "RESULTING TRIANGLES COMPOSED - PROCEED TO UNION TO FINAL OUTLINE LWPOLY" "Choose option : " 36))
  343.         (progn
  344.           (setq el (entlast))
  345.           (foreach lww lws
  346.             (setq regs
  347.               (cons
  348.                 (progn
  349.                   (vl-cmdf "_.region" lww "")
  350.                   (if (not (eq el (setq el (entlast))))
  351.                     el
  352.                   )
  353.                 ) regs
  354.               )
  355.             )
  356.           )
  357.           (setq ss (ssadd))
  358.           (foreach reg regs
  359.             (ssadd reg ss)
  360.           )
  361.           (vl-cmdf "_.union" ss "")
  362.           (if
  363.             (setq regs
  364.               (vl-remove-if (function vlax-erased-p) regs)
  365.             )
  366.             (if (not (cadr regs))
  367.               (setq reg (car regs))
  368.             )
  369.           )
  370.           (if (= (cdr (assoc 0 (entget (if reg reg (setq reg (entlast)))))) "REGION")
  371.             (progn
  372.               (vl-cmdf "_.explode" reg)
  373.               (while (< 0 (getvar (quote cmdactive)))
  374.                 (vl-cmdf "")
  375.               )
  376.               (setq el (entlast))
  377.               (setq ss (ssget "_P"))
  378.               (vl-cmdf "_.pedit" "_m" ss "" "_j")
  379.               (while (< 0 (getvar (quote cmdactive)))
  380.                 (vl-cmdf "")
  381.               )
  382.               (if
  383.                 (or
  384.                   (eq el (setq el (entlast)))
  385.                   (= (cdr (assoc 0 (setq enx (entget el)))) "LWPOLYLINE")
  386.                 )
  387.                 (entupd
  388.                   (cdr
  389.                     (assoc -1
  390.                       (entmod
  391.                         (if (assoc 62 enx)
  392.                           (subst (cons 62 3) (assoc 62 enx) enx)
  393.                           (append enx (list (cons 62 3)))
  394.                         )
  395.                       )
  396.                     )
  397.                   )
  398.                 )
  399.               )
  400.               (prompt "\nSource LWPOLYLINE length : ") (princ (vla-get-length (vlax-ename->vla-object lw)))
  401.               (prompt "\nResulting LWPOLYLINE length : ") (princ (vla-get-length (vlax-ename->vla-object el)))
  402.             )
  403.           )
  404.         )
  405.       )
  406.       (if trl
  407.         (progn
  408.           (prompt "\nSome triangles haven't been processed...")
  409.           (if (= 6 (LM:popup "SHOW UNPROCESSED TRIANGLES" "Choose option : " 36))
  410.             (princ trl)
  411.           )
  412.           (prompt "\nTotal : ") (princ (length trl)) (prompt " unprocessed triangles...")
  413.         )
  414.       )
  415.       (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
  416.     )
  417.     (progn
  418.       (prompt "\nMissed..., or picked wrong entity type, or picked LWPOLYLINE not closed, or picked LWPOLYLINE not polygonal - has arced segments...")
  419.       (if (= 4 (LM:popup "DECOMPOSITION+COMPOSITION - IRREGULAR POLYGON" "Choose option : " 53))
  420.         (c:decomposition+composition)
  421.       )
  422.     )
  423.   )
  424.   (*error* nil)
  425. )
  426.  
« 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: 3225
  • 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: 1398
  • 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: 3225
  • 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: 3225
  • 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

  • Swamp Rat
  • Posts: 723
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: 3225
  • 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: 3225
  • 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: 3225
  • 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.     (progn
  39.       (setq lst
  40.         (groupbynum
  41.           (vlax-invoke
  42.             (setq tmp
  43.               (vlax-ename->vla-object
  44.                 (entmakex
  45.                   (list
  46.                     (cons 0 "RAY")
  47.                     (cons 100 "AcDbEntity")
  48.                     (cons 100 "AcDbRay")
  49.                     (cons 10 pt)
  50.                     (cons 11 (trans (list 1.0 0.0 0.0) ent 0))
  51.                   )
  52.                 )
  53.               )
  54.             )
  55.             (quote intersectwith) obj acextendnone
  56.           ) 3
  57.         )
  58.       )
  59.       (vla-delete tmp)
  60.       (setq nrm (cdr (assoc 210 (entget ent))))
  61.       ;; gile:
  62.       (and
  63.         lst
  64.         (not (vlax-curve-getparamatpoint ent pt))
  65.         (= 1 (rem (length (vl-remove-if (function (lambda ( p / pa p- p+ p0 )
  66.                                                     (setq pa (vlax-curve-getparamatpoint ent p))
  67.                                                     (and (setq p- (cond ((setq p- (vlax-curve-getPointatParam ent (- pa 1e-8)))
  68.                                                                          (trans p- 0 nrm)
  69.                                                                         )
  70.                                                                         ((trans (vlax-curve-getPointatParam ent (- (vlax-curve-getEndParam ent) 1e-8)) 0 nrm)
  71.                                                                         )
  72.                                                                   )
  73.                                                          )
  74.                                                          (setq p+ (cond ((setq p+ (vlax-curve-getPointatParam ent (+ pa 1e-8)))
  75.                                                                          (trans p+ 0 nrm)
  76.                                                                         )
  77.                                                                         ((trans (vlax-curve-getPointatParam ent (+ (vlax-curve-getStartParam ent) 1e-8)) 0 nrm)
  78.                                                                         )
  79.                                                                   )
  80.                                                          )
  81.                                                          (setq p0 (trans pt 0 nrm))
  82.                                                          (<= 0 (* (sin (angle p0 p-)) (sin (angle p0 p+)))) ;; LM Mod
  83.                                                     )
  84.                                                   )
  85.                                         ) lst
  86.                           )
  87.                   ) 2
  88.              )
  89.         )
  90.       )
  91.     )
  92.     (prompt "\nReference curve isn't planar...")
  93.   )
  94. )
  95.  

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: 3225
  • 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