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

0 Members and 1 Guest are viewing this topic.

ribarm

  • Water Moccasin
  • Posts: 2067
  • 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: 1540
  • 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: 2067
  • 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: 1676
  • 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: 2067
  • 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: 2067
  • 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

snownut2

  • Swamp Rat
  • Posts: 930
  • ADT 2004 - AutoCad 2011 Bricscad 19
Re: Triangulation (re-visited)
« Reply #774 on: April 19, 2019, 12:45:41 PM »
Well the absence of YMG here is definitely felt.  I had emailed with YMG in the past and sent him an email the other day, I have yet to receive any reply.  Yesterday I did a bit of googling of his name in Quebec, the results where dis-heartening.  It appears we may never see the version 7 he was working on. (I hope I'm mistaken)

I have done some editing of the Triangulation program that he had been so feverishly working on, I would like to post it here, but wanted to get a sense from others if this would be proper.  I didn't add any additional features, just cleaned up what was already there and made everything accessible via DCL, including the ability to utilize multiple TIN's, which he had started but did not fully incorporate.

CostinBos77

  • Mosquito
  • Posts: 19
  • Land surveyor in action !
Re: Triangulation (re-visited)
« Reply #775 on: April 20, 2019, 07:52:18 AM »
Hello ,

Almoste there .

Many thanks to Mr. ElpanovEvgeniy , the brain of the engine of initial Triangulate lisp from 2008 .
« Last Edit: April 28, 2019, 02:18:45 AM by CostinBos77 »
Land surveyor in action !!!

:yes:

anhquang1989

  • Newt
  • Posts: 67
Re: Triangulation (re-visited)
« Reply #776 on: April 21, 2019, 10:46:33 PM »
Costibos77. Worderfull
You can share lisp. Thank you

CostinBos77

  • Mosquito
  • Posts: 19
  • Land surveyor in action !
Re: Triangulation (re-visited)
« Reply #777 on: April 22, 2019, 09:58:53 AM »
Hello everybody and anhquang1989 ,

download the attached .rar file , unzip and read the .pdf files .

If you agree , don't hesitate to contact me .

PS :
I tested it only in AutoCAD , so I am not sure about other software !

Regards ,

Costin

« Last Edit: April 28, 2019, 01:53:18 AM by CostinBos77 »
Land surveyor in action !!!

:yes:

pawcyk

  • Mosquito
  • Posts: 9
Re: Triangulation (re-visited)
« Reply #778 on: April 25, 2019, 03:06:51 AM »
CostinBos77, do you know if this program works with GStarCAD or ZWCAD??

CostinBos77

  • Mosquito
  • Posts: 19
  • Land surveyor in action !
Re: Triangulation (re-visited)
« Reply #779 on: April 25, 2019, 03:43:03 AM »
Hello pawcyk ,

Should work , if commands + Auto Lisp / Visual Lisp and DCL functions are the same .

From my experience ,  when I tried on BricsCAD , don't work integrally.

Because the softwares are different !

But you can try it , is free isn't ?


« Last Edit: April 25, 2019, 04:46:52 AM by CostinBos77 »
Land surveyor in action !!!

:yes: