Topic: Triangulation

[ymg]

Bullah,

Your modified code was working.  However a point does not show much unless you
change DDPTYPE.

Here I have modified so that the points are entmake'd and kept the list in the command line:

Code - Auto/Visual Lisp: [Select]

1. ;; Given the ename of a 3DFACE                                                ;
2. ;; Returns List of 3 unique points forming that face                          ;
3. (defun 3df->pl (en)
4.   (defun distinct (l) (if l (cons (car l) (distinct (vl-remove (car l) l)))))
5.   (setq ent (entget en)
6.           l (distinct (mapcar '(lambda (a) (cdr (assoc a ent))) '(10 11 12 13)))
7.   )
8. )
9.  
10. ;; Given 2 List                                                               ;
11. ;; Returns List of Elements Common to Both List.                              ;
12. (defun common (l1 l2)
13.   (if l1
14.      (if (member (car l1) l2)
15.         (cons (car l1) (common (cdr l1) l2))
16.         (common (cdr l1) l2)
17.      )
18.   )
19. )
20.  
21. ;; Given a Selection Set of Entities                                          ;
22. ;; Returns List of ename                                                      ;
23. (defun ss->enl ( ss / i l )
24.     (if ss
25.        (repeat (setq i (sslength ss))
26.             (setq l (cons (ssname ss (setq i (1- i))) l))
27.        )
28.     )
29. )
30.  
31.  
32. (defun crossproduct (u v)
33.   (list
34.     (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
35.     (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
36.     (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
37.   )
38. )
39.  
40. (defun getz (p p1 p2 p3 / n)  
41.    (setq p (list (car p) (cadr p) 0.)
42.          n (crossproduct (mapcar '- p2 p1) (mapcar '- p3 p1))        
43.    )
44.    (list (car p)(cadr p)(/ (apply '+ (mapcar '* n (mapcar '- p1 p)))(caddr n)))
45. )
46.  
47. ;; Return the maximum extent along the X of Selection Set of 3DFACE           ;
48. (defun maxtr (ss /  i ent tmp bb rtn)
49.   (setq  rtn 0)      
50.   (repeat (setq i (sslength ss))
51.      (setq ent (entget (ssname ss (setq i (1- i))))
52.            tmp (mapcar '(lambda (a) (cdr (assoc a ent))) '(10 11 12 13))
53.             bb (list (apply 'mapcar (cons 'min tmp)) (apply 'mapcar (cons 'max tmp)))
54.            rtn (max rtn (- (caadr bb) (caar bb)))
55.      )
56.   )
57. )    
58.  
59. ;|                                                          
60.                   Función zpto                              
61.                                                           |;
62.  
63. (defun c:zpto (/ p enl enl1 enl2 tr)
64.   (setvar "osmode" 0)
65.   (setq maxt (maxtr (ssget "_X"  '((0 . "3DFACE")))))  
66.   (while (setq p (getpoint "\nPick a Point: "))
67.  
68.     ;Searching For The Repeated 3DFACE
69.     (setq enl1 (ss->enl (ssget "_F" (list p (list (+ (car p) maxt) (cadr p))) '((0 . "3DFACE"))))
70.           enl2 (ss->enl (ssget "_F" (list p (list (- (car p) maxt) (cadr p))) '((0 . "3DFACE"))))
71.     )
72.     (cond
73.        ((setq enl (common enl1 enl2)) (setq tr (3df->pl (car enl))
74.                                              p (getz p (car tr) (cadr tr) (caddr tr))
75.                                       )      
76.                                       (entmakex (list '(0 . "POINT") (cons 10 p)))
77.                                       (princ "\nPoint on 3dFace: ")
78.                                       (princ p)
79.        )
80.        (t (princ"\nPoint is Outside of  TIN"))
81.     )
82.   )
83. )
84.  

[bullah]

"terima kasih tuan"  thank you sir 

[ymg]

Terima kasih kembali, Bullah