Topic: Triangulation (re-visited)

[chlh_jd]

Ymg,
Thank you for fix this case .
some suggest :
1. Another use case may can be : First select norm ,just like (210 1.0 0.0 0.0 ) , not only for (210 0. 0. 1.) ; and then trans all 3dfaces points , and then make contours .
   

Code: [Select]

  (contour  pl  tl intv  majcnt majcolor    mincolor hfac  norm)2. In the "get_ss" function , will be error , if the 3dface is manual change ( because of the osnap accuracy ), it can be solve by two way :
   2.1 tolerance index come in , such as (equalmember p pl 1e-6) replace  (vl-position p pl).
   2.2 fix or round coordinate before construct the pointlist , such as
     

Code: [Select]

(setq pl (cons (mapcar (function (lambda (a) (/ (fix (* a 1e6)) 1e6))) p) pl)3. In the contour function , some position may get error :
  3.1 build xl part
   

Code - Auto/Visual Lisp: [Select]

1. (while (setq n (vl-position nxt cl))     
2.            (setq  cl (vl-remove nxt cl)
3.                    n (- n (rem n 2))
4.                    m (nth n cl);_cl may be nil after first 'vl-remove .
5.                  pol (cons m pol)
6.                   cl (vl-remove m cl)
7.            )
8.            (if (vl-position nxt pol)
9.               (setq nxt nil)
10.               (setq nxt (reverse (car pol)))
11.            )
12.          
13.            (if (not (vl-position nxt cl))
14.               (setq pol (reverse pol)
15.                     nxt (reverse (car pol))
16.               )
17.            )  
18.        )
19.    

   3.2 foreach for xl part
 

Code - Auto/Visual Lisp: [Select]

1.     (foreach p xl ;_p may be has nil item , just like ((17 9) nil)
2.         (setq ent nil)
3.       ...)
4.  

  3.2 in the cond t condtion
 

Code - Auto/Visual Lisp: [Select]

1.     (foreach p xl
2.             ...
3.        (while (> (length p) 2)
4.             ...
5.           (cond (...)
6.                    (...)
7.                    (t (setq cn1 (list (/ (+ (car p1) (car p2) (car p3)) 3.)
8.                            (/ (+ (cadr p1) (cadr p2) (cadr p3)) 3.))
9.                  cn2 (list (/ (+ (car p1) (car p3) (car p4)) 3.)
10.                            (/ (+ (cadr p1) (cadr p3) (cadr p4)) 3.))
11.                  ;_ (cn1 p1 v1 v2) or (cn1 p3 v1 v2) may be collinear 4 points , how deal it ?
12.                  a1  (cond
13.                        ((inters cn1 p1 v1 v2))
14.                        ((inters cn1 p3 v1 v2))
15.                        )
16.                  a3  (cond
17.                        ((inters cn2 p1 v2 v3))
18.                        ((inters cn2 p3 v2 v3))
19.                        ))
20.                           ...
21.                        )
22.                    ...
23.                   )
24.                 ...
25.                )
26.  

[ymg]

chlh_jd,

not sure I am following you on all this.

Originally the program would not check for duplicate points.

Maybe I could add something in "gettin" to detect illegal
3dfaces.  However all these checks do take time.

All in all there will always be a way where you can throw
the program off if only due to limited precision of floating
point operations.

If you feed it garbage you will get garbage.

ymg

[chlh_jd]

You're right .
In the wrong direction to go right path indeed make road twists and turns .

[chlh_jd]

Can we use the autocad contour method ?
The output functions from acgex17.dll in ACAD2008 seems seems to have it .

Code: [Select]

?getContour@AcGeCurveBoundary@@QBEXAAHPAPAPAVAcGeEntity3d@@PAPAPAVAcGeCurve2d@@PAPAH3@Z
?getContour@AcGeImpCurveBoundary@@QBEXAAHPAPAPAVAcGeImpEntity3d@@PAPAPAVAcGeImpCurve3d@@PAPAH3@Z
?getContours@AcGeExternalBoundedSurface@@QBEXAAHAAPAVAcGeCurveBoundary@@@Z
?getContours@AcGeImpExternalBoundedSurface@@QBEXAAHAAPAVAcGeImpCurveBoundary@@@Z


[ymg]

chlh_jd,

Really don't know.  Worth a try!

[hanhphuc]

ymg,
is a fantastic tool.
However, PROF function is not working. Always returns the same error.

Command: prof

Select a Linear Entity:

Error: bad argument type: fixnump: nil

I am using a lwpolyline as a linear entity. Not sure what am I doing wrong.
Attached the sample file

hi teknomatika, maybe one of the endpoints (line entity's) is outside the TIN boundary?

[hanhphuc]

hi chlh_jd, this arx sample used by surveyor jobs can be applied in function: getz?
if we hide the first line (geomcal)** then we still can use ymg's getz, because ARX not loaded
ymg

Code: [Select]

(if C:cal (princ "\nGeomcal loaded..")(arxload "geomcal"));** <-- this is optional

(if C:cal ;if loaded
 
(defun getz (p t1 t2 t3 / ptt ) ;defun opted by hanhphuc
(setq
ptt (list (car p)(cadr p)(1+(caddr p))))
(cal "ilp(p,ptt,t1,t2,t3)")
); getz
 
(defun getz .... code unchanged ) ;defun by ymg
       
) ;c:cal


[ribarm]

No need for geomcal.arx

Code - Auto/Visual Lisp: [Select]

1. ;|(defun _ilp ( p1 p2 t1 t2 t3 / unit v^v Coplanar-p ptinsidetriangle-p n e p1e p2e p1ed p2ed p1p p2p v1 v2 )
2.  
3.   (defun unit ( v )
4.     (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
5.   )
6.  
7.   (defun v^v ( v1 v2 )
8.     (
9.       (lambda ( a b )
10.         (mapcar '(lambda ( a1 a2 b1 b2 ) (- (* a1 a2) (* b1 b2)))
11.                  a (cdr b) b (cdr a)
12.         )
13.       )
14.       (list (cadr v1) (caddr v1) (car v1) (cadr v1))
15.       (list (cadr v2) (caddr v2) (car v2) (cadr v2))
16.     )
17.   )
18.  
19.   (defun Coplanar-p ( p1 p2 p3 p4 )
20.     (
21.       (lambda ( n1 n2 )
22.         (equal (v^v n1 n2) '(0.0 0.0 0.0) 1e-8)
23.       )
24.       (v^v (mapcar '- p1 p2) (mapcar '- p1 p3))
25.       (v^v (mapcar '- p1 p2) (mapcar '- p1 p4))
26.     )
27.   )
28.  
29.   (defun ptinsidetriangle-p ( pt p1 p2 p3 )
30.     (if
31.       (and
32.         (Coplanar-p pt p1 p2 p3)
33.         (not
34.           (or
35.             (inters pt p1 p2 p3)
36.             (inters pt p2 p1 p3)
37.             (inters pt p3 p1 p2)
38.           )
39.         )
40.         (not
41.           (or
42.             (> (+ (distance pt p1) (distance pt p2)) (+ (distance p3 p1) (distance p3 p2)))
43.             (> (+ (distance pt p2) (distance pt p3)) (+ (distance p1 p2) (distance p1 p3)))
44.             (> (+ (distance pt p3) (distance pt p1)) (+ (distance p2 p3) (distance p2 p1)))
45.           )
46.         )
47.       )
48.       T
49.       nil
50.     )
51.   )
52.  
53.   (setq n (unit (v^v (mapcar '- t2 t1) (mapcar '- t3 t1))))
54.   (setq e (last (trans t1 0 n)))
55.   (setq p1e (last (trans p1 0 n)))
56.   (setq p2e (last (trans p2 0 n)))
57.   (setq p1ed (abs (- p1e e)))
58.   (setq p2ed (abs (- p2e e)))
59.   (setq p1p (mapcar '+ p1 (setq v1 (mapcar '(lambda ( x ) (* p1ed x)) n))))
60.   (setq p2p (mapcar '+ p2 (setq v2 (mapcar '(lambda ( x ) (* p2ed x)) n))))
61.   (if (not (equal e (last (trans p1p 0 n)) 1e-8)) (setq p1p (mapcar '- p1 v1)))
62.   (if (not (equal e (last (trans p2p 0 n)) 1e-8)) (setq p2p (mapcar '- p2 v2)))
63.   (setq p (inters p1 p2 p1p p2p nil))
64.   (if (ptinsidetriangle-p p t1 t2 t3)
65.     p
66.     nil
67.   )
68.  
69. )|;
70.  

Maybe this shorter variant - I think it's the same, but check - I would use this one :

Code - Auto/Visual Lisp: [Select]

1. ;|
2. (defun _ilp ( p1 p2 t1 t2 t3 / v^v Coplanar-p ptinsidetriangle-p n e p1n p2n p1p p2p )
3.  
4.   (defun v^v ( v1 v2 )
5.     (
6.       (lambda ( a b )
7.         (mapcar '(lambda ( a1 a2 b1 b2 ) (- (* a1 a2) (* b1 b2)))
8.                  a (cdr b) b (cdr a)
9.         )
10.       )
11.       (list (cadr v1) (caddr v1) (car v1) (cadr v1))
12.       (list (cadr v2) (caddr v2) (car v2) (cadr v2))
13.     )
14.   )
15.  
16.   (defun Coplanar-p ( p1 p2 p3 p4 )
17.     (
18.       (lambda ( n1 n2 )
19.         (equal (v^v n1 n2) '(0.0 0.0 0.0) 1e-8)
20.       )
21.       (v^v (mapcar '- p1 p2) (mapcar '- p1 p3))
22.       (v^v (mapcar '- p1 p2) (mapcar '- p1 p4))
23.     )
24.   )
25.  
26.   (defun ptinsidetriangle-p ( pt p1 p2 p3 )
27.     (if
28.       (and
29.         (Coplanar-p pt p1 p2 p3)
30.         (not
31.           (or
32.             (inters pt p1 p2 p3)
33.             (inters pt p2 p1 p3)
34.             (inters pt p3 p1 p2)
35.           )
36.         )
37.         (not
38.           (or
39.             (> (+ (distance pt p1) (distance pt p2)) (+ (distance p3 p1) (distance p3 p2)))
40.             (> (+ (distance pt p2) (distance pt p3)) (+ (distance p1 p2) (distance p1 p3)))
41.             (> (+ (distance pt p3) (distance pt p1)) (+ (distance p2 p3) (distance p2 p1)))
42.           )
43.         )
44.       )
45.       T
46.       nil
47.     )
48.   )
49.  
50.   (setq n (v^v (mapcar '- t2 t1) (mapcar '- t3 t1)))
51.   (setq e (last (trans t1 0 n)))
52.   (setq p1n (list (car (trans p1 0 n)) (cadr (trans p1 0 n)) e))
53.   (setq p2n (list (car (trans p2 0 n)) (cadr (trans p2 0 n)) e))
54.   (setq p1p (trans p1n n 0))
55.   (setq p2p (trans p2n n 0))
56.   (setq p (inters p1 p2 p1p p2p nil))
57.   (if (ptinsidetriangle-p p t1 t2 t3)
58.     p
59.     nil
60.   )
61.  
62. )|;
63.  

Both codes aren't correct... My update can be found here :
www.cadtutor.net/forum/showthread.php?89154-Solids-intersection-and-something-else...&s=293246d38c1367703f834a7d79f7944d&p=610836#post610836

M.R.

[ymg]

I have gone through 5 different version of getz before settling on the last one.

Here they are:

Code - Auto/Visual Lisp: [Select]

1. (defun getz0 (p t1 t2 t3 /  v1 v2)
2.  
3.    (setq v1 (mapcar '- t2 t1)
4.          v2 (mapcar '- t3 t1)
5.           n (list (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
6.                   (- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))  
7.                   (- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))    
8.             )
9.    )
10.    (list (car p)(cadr p)(/ (apply '+ (mapcar '* n (mapcar '- t1 p)))(caddr n)))
11.  )
12.  
13. (defun getz1 (p t1 t2 t3 / )
14.  
15.    (setq v0 (list (- (car t1) (car  p)) (- (cadr t1) (cadr  p)) (- (caddr t1) (caddr  p)))
16.          v1 (list (- (car t2) (car t1)) (- (cadr t2) (cadr t1)) (- (caddr t2) (caddr t1)))
17.          v2 (list (- (car t3) (car t1)) (- (cadr t3) (cadr t1)) (- (caddr t3) (caddr t1)))
18.           n (list (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
19.                   (- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))  
20.                   (- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))    
21.             )
22.    )
23.    (list (car p)(cadr p)(/ (apply '+ (mapcar '* n v0))(caddr n)))
24.  )
25.  
26. (defun getz2 (p t1 t2 t3 /  v1 v2)
27.    (setq x  (car  p)  y  (cadr p)  z (caddr p)
28.          x1 (car t1) y1 (cadr t1) z1 (caddr t1)
29.          x2 (car t2) y2 (cadr t2) z2 (caddr t2)
30.          x3 (car t3) y3 (cadr t3) z3 (caddr t3)
31.           n (list (- (* (- y2 y1) (- z3 z1)) (* (- z2 z1) (- y3 y1)))
32.                   (- (* (- z2 z1) (- x3 x1)) (* (- x2 x1) (- z3 z1)))  
33.                   (- (* (- x2 x1) (- y3 y1)) (* (- y2 y1) (- x3 x1)))    
34.             )            
35.    )
36.  
37.    (list (car p)(cadr p)(/ (apply '+ (mapcar '* n v0))(caddr n)))
38.  )
39.  
40. (defun getz3 (p t1 t2 t3 /  v1 v2)
41.    (setq x  (car  p)  y  (cadr p)  z (caddr p)
42.          x1 (car t1) y1 (cadr t1) z1 (caddr t1)
43.          x2 (car t2) y2 (cadr t2) z2 (caddr t2)
44.          x3 (car t3) y3 (cadr t3) z3 (caddr t3)
45.           n (list (- (* (- y2 y1) (- z3 z1)) (* (- z2 z1) (- y3 y1)))
46.                   (- (* (- z2 z1) (- x3 x1)) (* (- x2 x1) (- z3 z1)))  
47.                   (- (* (- x2 x1) (- y3 y1)) (* (- y2 y1) (- x3 x1)))    
48.             )            
49.    )
50.  
51.    (list (car p)(cadr p)(/ (+ (* (- x1 x) (car n)) (* (- y1 y) (cadr n)) (* (- z1 z) (caddr n))) (caddr n)))
52.  )
53.  
54. (defun getz4 (p t1 t2 t3 / n1 n2 n3 x x1 x2 x3 y y1 y2 y3 z z1 z2 z3)
55.    (setq x  (car  p)  y  (cadr p)
56.          x1 (car t1) y1 (cadr t1) z1 (caddr t1)
57.          x2 (car t2) y2 (cadr t2) z2 (caddr t2)
58.          x3 (car t3) y3 (cadr t3) z3 (caddr t3)
59.          n1 (- (* (- y2 y1) (- z3 z1)) (* (- z2 z1) (- y3 y1)))
60.          n2 (- (* (- z2 z1) (- x3 x1)) (* (- x2 x1) (- z3 z1)))  
61.          n3 (- (* (- x2 x1) (- y3 y1)) (* (- y2 y1) (- x3 x1)))                      
62.    )  
63.    (list x y (/ (+ (* (- x1 x) n1) (* (- y1 y) n2) (* z1 n3)) n3))
64.  )
65.  
66. (defun getz5 (p t1 t2 t3 / n1 n2 n3 x x1 x21 x31 y y1 y21 y31 z1 z21 z31)
67.    (setq  x (car  p)  y (cadr  p)
68.          x1 (car t1) y1 (cadr t1) z1 (caddr t1)        
69.         x21 (- (car t2) x1)  y21 (- (cadr t2) y1) z21 (- (caddr t2) z1)
70.         x31 (- (car t3) x1)  y31 (- (cadr t3) y1) z31 (- (caddr t3) z1)
71.          n1 (- (* y21 z31) (* z21 y31))
72.          n2 (- (* z21 x31) (* x21 z31))  
73.          n3 (- (* x21 y31) (* y21 x31))                      
74.    )  
75.    (list x y (/ (+ (* (- x1 x) n1) (* (- y1 y) n2) (* z1 n3)) n3))
76.  )
77.  

now here are the results of a speed test including  marko's and hanphuc's versions.

(testgetz)

ymg0.    Elapsed: 2.761 sec.
ymg1.    Elapsed: 1.700 sec.
ymg2.    Elapsed: 1.514 sec.
ymg3.    Elapsed: 0.717 sec.
ymg4.    Elapsed: 0.609 sec.
ymg5.    Elapsed: 0.546 sec.
hanphuc. Elapsed: 16.162 sec.
marko1.  Elapsed: 10.608 sec.
marko2.  Elapsed: 7.581 sec.
_$

[chlh_jd]

hi chlh_jd, this arx sample used by surveyor jobs can be applied in function: getz?
if we hide the first line (geomcal)** then we still can use ymg's getz, because ARX not loaded
...

I don't think so that use (cal "ilp...") would be faster than Ymg's getz function , because of it should cal not only z coor.
What I show In reply 168# I post , it's AutoCAD Interface routine , It does not have to be called through Vlisp .

[ymg]

What I show In reply 168# I post , it's AutoCAD Interface routine

chlh_jd

not too sure that the functions in your post are applicable to isolines.

ymg

[chlh_jd]

What I show In reply 168# I post , it's AutoCAD Interface routine

chlh_jd

not too sure that the functions in your post are applicable to isolines.

ymg

1+

[ymg]

I have added a new command to the triangulation program
to creates a boundary (concave hull) around the point set.

As you know there is no single solution to this problem.

However based on this paper:
 Efficient generation of simple polygons for characterizing the shape of a set of points in the plane

by Matt Duckham, Lars Kulik, Mike Worboys, Antony Galton

I have come up with a dynamic way to get a solution by
varying the length parameter from 0.1 to 1 and displaying
the resulting polygon.  You start with parameter set at 0.5
pressing "+" keys erodes the hull more, while minus erodes
less.

Of course when the parameter is equal to 1 what you have is
the Convex Hull.
 
Pressing "ENTER" or "SPACE BAR" or "LEFT-CLICK" will
accept the new Boundary, and the 3dface outside of it
will be deleted.

Pressing "RIGHT-CLICK" will cancel the operation.

There is room for optimization, but the speed ain't bad.

ymg

[ymg]

Here a small video illustrating the use of Xshape:

[pedroantonio]

Hi ymg i need some help with your code.Until yesterday the code works fine.Today when i try to use it gives me this alert message

Error in dialog file

"C:\Users\Prodromos\AppData\Local\Temp\tin.dcl", line 401: newline in string constant

Error in dialog file
"C:\Users\Prodromos\AppData\Local\Temp\tin.dcl", line 402: missing semicolon

Error in dialog file

"C:\Users\Prodromos\AppData\Local\Temp\tin.dcl", line 402:
syntax error
Symbol: "0
0.0
0.00".

why? Any ideas

Thanks