Author Topic: Triangulation (re-visited)  (Read 120424 times)

0 Members and 1 Guest are viewing this topic.

ribarm

  • Water Moccasin
  • Posts: 2014
  • Marko Ribar, architect
Re: Triangulation (re-visited)
« Reply #765 on: March 04, 2019, 06:22:30 AM »
What should the triangles look like for these four points?

Well I assume that if circumcircle should touch only 3 points in triangle and none of other points placed inside that circumcircle, then your first png should be correct...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1539
  • Moscow (Russia)
Re: Triangulation (re-visited)
« Reply #766 on: March 04, 2019, 06:57:53 AM »
but:
Code - Auto/Visual Lisp: [Select]
  1. (distance '(0 0 0) '(3 3 0))    ; 4.24264
  2. (distance '(1 2 -20) '(2 1 20)) ; 40.025
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

ribarm

  • Water Moccasin
  • Posts: 2014
  • Marko Ribar, architect
Re: Triangulation (re-visited)
« Reply #767 on: March 04, 2019, 07:38:14 AM »
2D projection is important... No matter which solution you choose 3D model of 2 triangle 3DFACEs is the same...

Code - Auto/Visual Lisp: [Select]
  1. Command: (distance '(0 0) '(3 3))
  2. 4.24264
  3. Command: (distance '(1 2) '(2 1))
  4. 1.41421
  5.  
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

rw2691

  • Newt
  • Posts: 125
Re: Triangulation (re-visited)
« Reply #768 on: March 04, 2019, 11:46:33 AM »
Without a breakline to dictate differently, common elevations should be directly linked. But this looks like a contrived situation. Normally, the shortest segments would be preferred. But any practitioner would have assigned a breakline. Even if the contours ended up looking the same with either.

Rick
Hippocrates (400BC), "Life is short, craft long, opportunity fleeting, experiment treacherous, judgment difficult."

Nilrac

  • Mosquito
  • Posts: 1
Re: Triangulation (re-visited)
« Reply #769 on: March 06, 2019, 05:35:57 PM »
I'm getting an error message when i try to run the TIN command,it says invalid attribute value left does anyone know how to resolve this?

rw2691

  • Newt
  • Posts: 125
Re: Triangulation (re-visited)
« Reply #770 on: March 07, 2019, 11:33:33 AM »
You need to give more information ...

Did you plot points with elevations?

How did you select the points for the TIN?

At what stage of the queries did you get the error?

I noticed that you are using BricsCAD. Which version? I have BricsCAD Version 18.2.20, and TIN works fine.

Rick
Hippocrates (400BC), "Life is short, craft long, opportunity fleeting, experiment treacherous, judgment difficult."

roy_043

  • Water Moccasin
  • Posts: 1663
  • BricsCAD 18
Re: Triangulation (re-visited)
« Reply #771 on: March 07, 2019, 04:15:06 PM »
@Nilrac:
On line 896 and line 908 change 'Left' to 'left' (DCL is case sensitive).
Erase the existing tinV0.6.7.dcl file before trying the revised code.

ribarm

  • Water Moccasin
  • Posts: 2014
  • Marko Ribar, architect
Re: Triangulation (re-visited)
« Reply #772 on: March 18, 2019, 11:45:29 AM »
Evgeniy, you probably thought on interpolation of existing TIN if pair of triangles have not coplanar set of points - 4 points share no common plane (in your example they share, but in practice this may not be the case almost always with 3D points in space)...

So, I wrote this code, but unfortunately amount of points may triple... So it IS desperately needed faster DTR algorithm for triangulation...

P.S. Daniel, haven't replied to my PM. Sorry, but I think he is not interested in making new *.arx...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:interpolatetriangulation ( / unique vl-position-fuzz ss i 3df pl tr trl e1 e2 e3 e1tr e2tr e3tr p1 p2 ip ipp1p2 ipe1 ipe2 ipe3 )
  2.  
  3.  (defun unique ( l )
  4.    (if l
  5.      (cons (car l)
  6.        (unique (vl-remove-if '(lambda ( x ) (equal x (car l) 1e-6)) l))
  7.      )
  8.    )
  9.  )
  10.  
  11.  (defun vl-position-fuzz ( e l fuzz / car-vl-member-if )
  12.    (defun car-vl-member-if ( f l / ff r )
  13.      (setq ff '(lambda ( x ) (if (apply f (list x)) (setq r x))))
  14.      (vl-some ff l)
  15.      r
  16.    )
  17.    (vl-position (car-vl-member-if '(lambda ( x ) (equal e x fuzz)) l) l)
  18.  )
  19.  
  20.  (prompt "\nSelect TIN 3DFACE entities...")
  21.  (if (setq ss (ssget '((0 . "3DFACE"))))
  22.    (progn
  23.      (repeat (setq i (sslength ss))
  24.        (setq 3df (ssname ss (setq i (1- i))))
  25.        (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (vl-position (car x) '(10 11 12 13))) (entget 3df))))
  26.        (setq tr (unique pl))
  27.        (setq trl (cons tr trl))
  28.      )
  29.      (setq pl nil)
  30.      (foreach tr trl
  31.        (setq e1 (list (car tr) (cadr tr)) e2 (list (cadr tr) (caddr tr)) e3 (list (caddr tr) (car tr)))
  32.        (setq e1tr (vl-some '(lambda ( tr ) (if (and (vl-position-fuzz (car e1) tr 1e-6) (vl-position-fuzz (cadr e1) tr 1e-6)) tr)) (vl-remove tr trl)))
  33.        (setq e2tr (vl-some '(lambda ( tr ) (if (and (vl-position-fuzz (car e2) tr 1e-6) (vl-position-fuzz (cadr e2) tr 1e-6)) tr)) (vl-remove tr trl)))
  34.        (setq e3tr (vl-some '(lambda ( tr ) (if (and (vl-position-fuzz (car e3) tr 1e-6) (vl-position-fuzz (cadr e3) tr 1e-6)) tr)) (vl-remove tr trl)))
  35.        (if e1tr
  36.          (progn
  37.            (setq p1 (caddr tr))
  38.            (setq p2 (car (vl-remove-if '(lambda ( x ) (equal (car e1) x 1e-6)) (vl-remove-if '(lambda ( y ) (equal (cadr e1) y 1e-6)) e1tr))))
  39.            (setq ip (inters (mapcar '+ '(0 0) p1) (mapcar '+ '(0 0) p2) (mapcar '+ '(0 0) (car e1)) (mapcar '+ '(0 0) (cadr e1))))
  40.            (if ip
  41.              (progn
  42.                (setq ip (list (car ip) (cadr ip) 0.0))
  43.                (setq ipp1p2 (inters p1 p2 ip (mapcar '+ ip '(0 0 1)) nil))
  44.                (setq ipe1 (inters (car e1) (cadr e1) ip (mapcar '+ ip '(0 0 1)) nil))
  45.                (setq pl (cons (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ipp1p2 ipe1) pl))
  46.              )
  47.            )
  48.          )
  49.        )
  50.        (if e2tr
  51.          (progn
  52.            (setq p1 (car tr))
  53.            (setq p2 (car (vl-remove-if '(lambda ( x ) (equal (car e2) x 1e-6)) (vl-remove-if '(lambda ( y ) (equal (cadr e2) y 1e-6)) e2tr))))
  54.            (setq ip (inters (mapcar '+ '(0 0) p1) (mapcar '+ '(0 0) p2) (mapcar '+ '(0 0) (car e2)) (mapcar '+ '(0 0) (cadr e2))))
  55.            (if ip
  56.              (progn
  57.                (setq ip (list (car ip) (cadr ip) 0.0))
  58.                (setq ipp1p2 (inters p1 p2 ip (mapcar '+ ip '(0 0 1)) nil))
  59.                (setq ipe2 (inters (car e2) (cadr e2) ip (mapcar '+ ip '(0 0 1)) nil))
  60.                (setq pl (cons (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ipp1p2 ipe2) pl))
  61.              )
  62.            )
  63.          )
  64.        )
  65.        (if e3tr
  66.          (progn
  67.            (setq p1 (cadr tr))
  68.            (setq p2 (car (vl-remove-if '(lambda ( x ) (equal (car e3) x 1e-6)) (vl-remove-if '(lambda ( y ) (equal (cadr e3) y 1e-6)) e3tr))))
  69.            (setq ip (inters (mapcar '+ '(0 0) p1) (mapcar '+ '(0 0) p2) (mapcar '+ '(0 0) (car e3)) (mapcar '+ '(0 0) (cadr e3))))
  70.            (if ip
  71.              (progn
  72.                (setq ip (list (car ip) (cadr ip) 0.0))
  73.                (setq ipp1p2 (inters p1 p2 ip (mapcar '+ ip '(0 0 1)) nil))
  74.                (setq ipe3 (inters (car e3) (cadr e3) ip (mapcar '+ ip '(0 0 1)) nil))
  75.                (setq pl (cons (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ipp1p2 ipe3) pl))
  76.              )
  77.            )
  78.          )
  79.        )
  80.      )
  81.      (setq pl (unique pl))
  82.      (foreach p pl
  83.        (entmake (list '(0 . "POINT") (cons 10 p)))
  84.      )
  85.      (prompt "\nInterpolation points created... Please remove existing TIN and retrinagulate with new points added...")
  86.    )
  87.  )
  88.  (princ)
  89. )
  90.  

Regards, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2014
  • Marko Ribar, architect
Re: Triangulation (re-visited)
« Reply #773 on: March 18, 2019, 04:48:44 PM »
This is maybe better - I played with previous one and wasn't quite satisfied... Note that IMHO best is to use 1 interpolation - not many as result may be with close points and very different elevations making no smooth transitions, but very odd triangulation...

Here is revision (I used (midpt (mid1 mid2)) - mid1-middle of edge - mid2-middle of 3rd points of adjacent triangles sharing that common edge...)

Code - Auto/Visual Lisp: [Select]
  1. (defun c:interpolatetriangulation-new ( / unique vl-position-fuzz ss i 3df pl tr trl e1 e2 e3 e1tr e2tr e3tr p1 p2 ip ipp1p2 ipe1 ipe2 ipe3 )
  2.  
  3.  (defun unique ( l )
  4.    (if l
  5.      (cons (car l)
  6.        (unique (vl-remove-if '(lambda ( x ) (equal x (car l) 1e-6)) l))
  7.      )
  8.    )
  9.  )
  10.  
  11.  (defun vl-position-fuzz ( e l fuzz / car-vl-member-if )
  12.    (defun car-vl-member-if ( f l / ff r )
  13.      (setq ff '(lambda ( x ) (if (apply f (list x)) (setq r x))))
  14.      (vl-some ff l)
  15.      r
  16.    )
  17.    (vl-position (car-vl-member-if '(lambda ( x ) (equal e x fuzz)) l) l)
  18.  )
  19.  
  20.  (prompt "\nSelect TIN 3DFACE entities...")
  21.  (if (setq ss (ssget '((0 . "3DFACE"))))
  22.    (progn
  23.      (repeat (setq i (sslength ss))
  24.        (setq 3df (ssname ss (setq i (1- i))))
  25.        (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (vl-position (car x) '(10 11 12 13))) (entget 3df))))
  26.        (setq tr (unique pl))
  27.        (setq trl (cons tr trl))
  28.      )
  29.      (setq pl nil)
  30.      (foreach tr trl
  31.        (setq e1 (list (car tr) (cadr tr)) e2 (list (cadr tr) (caddr tr)) e3 (list (caddr tr) (car tr)))
  32.        (setq e1tr (vl-some '(lambda ( tr ) (if (and (vl-position-fuzz (car e1) tr 1e-6) (vl-position-fuzz (cadr e1) tr 1e-6)) tr)) (vl-remove tr trl)))
  33.        (setq e2tr (vl-some '(lambda ( tr ) (if (and (vl-position-fuzz (car e2) tr 1e-6) (vl-position-fuzz (cadr e2) tr 1e-6)) tr)) (vl-remove tr trl)))
  34.        (setq e3tr (vl-some '(lambda ( tr ) (if (and (vl-position-fuzz (car e3) tr 1e-6) (vl-position-fuzz (cadr e3) tr 1e-6)) tr)) (vl-remove tr trl)))
  35.        (if e1tr
  36.          (progn
  37.            (setq p1 (caddr tr))
  38.            (setq p2 (car (vl-remove-if '(lambda ( x ) (equal (car e1) x 1e-6)) (vl-remove-if '(lambda ( y ) (equal (cadr e1) y 1e-6)) e1tr))))
  39.            (setq ip (inters (mapcar '+ '(0 0) p1) (mapcar '+ '(0 0) p2) (mapcar '+ '(0 0) (car e1)) (mapcar '+ '(0 0) (cadr e1))))
  40.            (if ip
  41.              (progn
  42.                (setq ipp1p2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2))
  43.                (setq ipe1 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car e1) (cadr e1)))
  44.                (setq pl (cons (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ipp1p2 ipe1) pl))
  45.              )
  46.            )
  47.          )
  48.        )
  49.        (if e2tr
  50.          (progn
  51.            (setq p1 (car tr))
  52.            (setq p2 (car (vl-remove-if '(lambda ( x ) (equal (car e2) x 1e-6)) (vl-remove-if '(lambda ( y ) (equal (cadr e2) y 1e-6)) e2tr))))
  53.            (setq ip (inters (mapcar '+ '(0 0) p1) (mapcar '+ '(0 0) p2) (mapcar '+ '(0 0) (car e2)) (mapcar '+ '(0 0) (cadr e2))))
  54.            (if ip
  55.              (progn
  56.                (setq ipp1p2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2))
  57.                (setq ipe2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car e2) (cadr e2)))
  58.                (setq pl (cons (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ipp1p2 ipe2) pl))
  59.              )
  60.            )
  61.          )
  62.        )
  63.        (if e3tr
  64.          (progn
  65.            (setq p1 (cadr tr))
  66.            (setq p2 (car (vl-remove-if '(lambda ( x ) (equal (car e3) x 1e-6)) (vl-remove-if '(lambda ( y ) (equal (cadr e3) y 1e-6)) e3tr))))
  67.            (setq ip (inters (mapcar '+ '(0 0) p1) (mapcar '+ '(0 0) p2) (mapcar '+ '(0 0) (car e3)) (mapcar '+ '(0 0) (cadr e3))))
  68.            (if ip
  69.              (progn
  70.                (setq ipp1p2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2))
  71.                (setq ipe3 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car e3) (cadr e3)))
  72.                (setq pl (cons (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ipp1p2 ipe3) pl))
  73.              )
  74.            )
  75.          )
  76.        )
  77.      )
  78.      (setq pl (unique pl))
  79.      (foreach p pl
  80.        (entmake (list '(0 . "POINT") (cons 10 p)))
  81.      )
  82.      (prompt "\nInterpolation points created... Please remove existing TIN and retrinagulate with new points added...")
  83.    )
  84.  )
  85.  (princ)
  86. )
  87.  

Regards, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube