### Author Topic: Triangulation (re-visited)  (Read 242720 times)

0 Members and 1 Guest are viewing this topic. ##### 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) #### ElpanovEvgeniy ##### 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 ##### 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) #### 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 »

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." ##### 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. ##### 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.       (repeat (setq i (sslength ss))
23.         (setq 3df (ssname ss (setq i (1- i))))
24.         (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (vl-position (car x) '(10 11 12 13))) (entget 3df))))
25.         (setq tr (unique pl))
26.         (setq trl (cons tr trl))
27.       )
28.       (setq pl nil)
29.       (foreach tr trl
31.         (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)))
32.         (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)))
33.         (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)))
34.         (if e1tr
36.             (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))))
37.             (setq ip (inters (mapcar '+ '(0 0) p1) (mapcar '+ '(0 0) p2) (mapcar '+ '(0 0) (car e1)) (mapcar '+ '(0 0) (cadr e1))))
38.             (if ip
39.                 (setq ip (list (car ip) (cadr ip) 0.0))
40.                 (setq ipp1p2 (inters p1 p2 ip (mapcar '+ ip '(0 0 1)) nil))
41.                 (setq ipe1 (inters (car e1) (cadr e1) ip (mapcar '+ ip '(0 0 1)) nil))
42.                 (setq pl (cons (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ipp1p2 ipe1) pl))
43.               )
44.             )
45.           )
46.         )
47.         (if e2tr
48.             (setq p1 (car tr))
49.             (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))))
50.             (setq ip (inters (mapcar '+ '(0 0) p1) (mapcar '+ '(0 0) p2) (mapcar '+ '(0 0) (car e2)) (mapcar '+ '(0 0) (cadr e2))))
51.             (if ip
52.                 (setq ip (list (car ip) (cadr ip) 0.0))
53.                 (setq ipp1p2 (inters p1 p2 ip (mapcar '+ ip '(0 0 1)) nil))
54.                 (setq ipe2 (inters (car e2) (cadr e2) ip (mapcar '+ ip '(0 0 1)) nil))
55.                 (setq pl (cons (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ipp1p2 ipe2) pl))
56.               )
57.             )
58.           )
59.         )
60.         (if e3tr
62.             (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))))
63.             (setq ip (inters (mapcar '+ '(0 0) p1) (mapcar '+ '(0 0) p2) (mapcar '+ '(0 0) (car e3)) (mapcar '+ '(0 0) (cadr e3))))
64.             (if ip
65.                 (setq ip (list (car ip) (cadr ip) 0.0))
66.                 (setq ipp1p2 (inters p1 p2 ip (mapcar '+ ip '(0 0 1)) nil))
67.                 (setq ipe3 (inters (car e3) (cadr e3) ip (mapcar '+ ip '(0 0 1)) nil))
68.                 (setq pl (cons (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ipp1p2 ipe3) pl))
69.               )
70.             )
71.           )
72.         )
73.       )
74.       (setq pl (unique pl))
75.       (foreach p pl
76.         (entmake (list '(0 . "POINT") (cons 10 p)))
77.       )
78.       (prompt "\nInterpolation points created... Please remove existing TIN and retrinagulate with new points added...")
79.     )
80.   )
81.   (princ)
82. )
83.

Regards, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)  ##### 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.       (repeat (setq i (sslength ss))
23.         (setq 3df (ssname ss (setq i (1- i))))
24.         (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (vl-position (car x) '(10 11 12 13))) (entget 3df))))
25.         (setq tr (unique pl))
26.         (setq trl (cons tr trl))
27.       )
28.       (setq pl nil)
29.       (foreach tr trl
31.         (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)))
32.         (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)))
33.         (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)))
34.         (if e1tr
36.             (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))))
37.             (setq ip (inters (mapcar '+ '(0 0) p1) (mapcar '+ '(0 0) p2) (mapcar '+ '(0 0) (car e1)) (mapcar '+ '(0 0) (cadr e1))))
38.             (if ip
39.                 (setq ipp1p2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2))
40.                 (setq ipe1 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car e1) (cadr e1)))
41.                 (setq pl (cons (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ipp1p2 ipe1) pl))
42.               )
43.             )
44.           )
45.         )
46.         (if e2tr
47.             (setq p1 (car tr))
48.             (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))))
49.             (setq ip (inters (mapcar '+ '(0 0) p1) (mapcar '+ '(0 0) p2) (mapcar '+ '(0 0) (car e2)) (mapcar '+ '(0 0) (cadr e2))))
50.             (if ip
51.                 (setq ipp1p2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2))
52.                 (setq ipe2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car e2) (cadr e2)))
53.                 (setq pl (cons (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ipp1p2 ipe2) pl))
54.               )
55.             )
56.           )
57.         )
58.         (if e3tr
60.             (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))))
61.             (setq ip (inters (mapcar '+ '(0 0) p1) (mapcar '+ '(0 0) p2) (mapcar '+ '(0 0) (car e3)) (mapcar '+ '(0 0) (cadr e3))))
62.             (if ip
63.                 (setq ipp1p2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2))
64.                 (setq ipe3 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car e3) (cadr e3)))
65.                 (setq pl (cons (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ipp1p2 ipe3) pl))
66.               )
67.             )
68.           )
69.         )
70.       )
71.       (setq pl (unique pl))
72.       (foreach p pl
73.         (entmake (list '(0 . "POINT") (cons 10 p)))
74.       )
75.       (prompt "\nInterpolation points created... Please remove existing TIN and retrinagulate with new points added...")
76.     )
77.   )
78.   (princ)
79. )
80.

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

• Swamp Rat
• Posts: 971 ##### 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 ##### 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 !!! #### anhquang1989

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

#### CostinBos77 ##### Re: Triangulation (re-visited)
« Reply #777 on: April 22, 2019, 09:58:53 AM »
Hello everybody and anhquang1989 ,

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 !!! #### 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 ##### 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 !!! 