Get the Z coordinate from a set of 3D faces at the specified point's coordinates

Friday at 07:43 AM

Hello everyone. I’m using a function that returns the Z coordinate from a set of 3D faces at the specified point’s coordinates, or nil if the coordinates are outside this set of 3D faces. However, I’ve encountered a problem: if the point’s coordinates lie exactly on a vertex or an edge of a 3D face, I also get nil. How can I handle this case so that when the point is on a vertex or edge of a 3D face, I still get the Z coordinate from that face? Thanks.

(defun get_Z_3Df (ss ptclick / acadObject acadDocument modelspace acadlayers acadblock util
                                    butlast midpoint ss objlist coordslist ptclick numerator
                                    denomiator cobj coord xc yc zc z0 i pfacelist ofacelist aface c0 c1 c2 c3 c4 c5
                                    j pvertexlist overtexlist xp yp zp zp1 atri fpt
                                    spt tpt cpt inter1 inter2 inter3 rtri rfpt rspt rtpt x0 x1 x2 y0 y1 y2 z1 z2
                    )
;-----------------
;; Example: (get_Z_3Df (ssget '((0 . "3dface"))) (getpoint "\nSpecify the point ->>"))
;-----------------
(vl-load-com)
;-----------------
(setq acadObject   (vlax-get-acad-object)
      acadDocument (vla-get-ActiveDocument acadObject)
      modelspace   (vla-get-ModelSpace acadDocument)
      acadlayers   (vla-get-layers acadDocument)
      acadblock    (vla-get-Blocks acadDocument)
      util         (vla-get-utility acadDocument)
)
;----------------------------------------------------------
(defun midpoint (a b) (polar a (angle a b) (* (distance a b) 0.5)))
;----------------------------------------------------------
(defun butlast (l) (reverse (cdr (reverse l))))
;----------------------------------------------------------

(setq objlist '() Cobj nil coords nil coordslist '() zc nil)
  (setq objlist (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
  (setq i objlist)
(repeat (length objlist)
        (setq cobj (car i) i (cdr i))
        (setq coord (vlax-safearray->list (vlax-variant-value (vlax-get-property cobj 'Coordinates))))
        (setq coordslist (cons coord coordslist))
      )
;-----------------------------
(setq xc (car ptclick) yc (cadr ptclick))
;======================================
(if (and
         ptclick
         ss
    )
    (progn
        (setq i coordslist)
      (setq pfacelist '())
      (setq ofacelist '())
        (repeat (length i)
            (setq aface (car i) i (cdr i))
            (setq c0 (car aface)
                c1 (cadr aface)
                c2 (caddr aface)
                c3 (cadddr aface)
                c4 (cadddr (cdr aface))
                c5 (cadddr (cddr aface))
            )
            (if (and (= c0 c3) (= c1 c4) (= c2 c5))
                (setq j 3)
                (setq j 0)
            )
            (setq pvertexlist '())
            (setq overtexlist '())
            (repeat (- (length aface) 3)
                (repeat j (setq aface (cdr aface)))
                (setq xp (car aface)
                    yp (cadr aface)
                    zp 0.0
                    zp1 (caddr aface)
                )
                (setq pvertexlist (cons (list xp yp zp) pvertexlist))
                (setq overtexlist (cons (list xp yp zp1) overtexlist))
                (setq j 3)
            )
            (setq pvertexlist (reverse pvertexlist))
            (setq overtexlist (reverse overtexlist))
            (setq pfacelist (cons pvertexlist pfacelist))
            (setq ofacelist (cons overtexlist ofacelist))
        )
 
      (repeat (length pfacelist)
        (setq atri (car pfacelist) pfacelist (cdr pfacelist))
        (setq fpt (car atri)
          spt (cadr atri)
          tpt (caddr atri)
        )
           
            (setq cpt (inters
                        fpt (midpoint spt tpt)
                        spt (midpoint fpt tpt)
                    )
                cpt (butlast cpt)
            )
           
            (setq inter1 (inters ptclick cpt fpt spt)
                inter2 (inters ptclick cpt spt tpt)
                inter3 (inters ptclick cpt tpt fpt)
            )
           
            (setq rtri (car ofacelist) ofacelist (cdr ofacelist))
            (setq rfpt (car rtri)
                rspt (cadr rtri)
                rtpt (caddr rtri)
            )
        (if (and (null inter1) (null inter2) (null inter3))
            (progn
                (setq x0 (car rfpt) y0 (cadr rfpt) z0 (caddr rfpt)
                      x1 (- (car rspt) x0) y1 (- (cadr rspt) y0) z1 (- (caddr rspt) z0)
                      x2 (- (car rtpt) x0) y2 (- (cadr rtpt) y0) z2 (- (caddr rtpt) z0)
                )
                (setq numerator (+ (* (- xc x0) (- (* y1 z2) (* y2 z1))) (* (- yc y0) (- (* x2 z1) (* x1 z2))))
                      denomiator (- (* x2 y1) (* x1 y2))
                )
                (if (not (zerop denomiator))
                    (setq zc (+ z0 (/ numerator denomiator)))
                ))))
      )
    )
zc
); end od defun

Friday at 10:42 AM

Hi @dilan
I understand that when that happens, it should simply return the vertex's z-coordinate. Therefore, it's just a matter of setting a filter before considering the other cases.
I've edited your code to avoid explanations that would likely be more extensive than doing it this way.

(defun get_Z_3Df (ss	   ptclick  /	     acadObject
		  acadDocument	    modelspace	      acadlayers
		  acadblock	    util     butlast  midpoint ss
		  objlist  coordslist	     ptclick  numerator
		  denomiator	    cobj     coord    xc       yc
		  zc	   z0	    i	     pfacelist	       ofacelist
		  aface	   c0	    c1	     c2	      c3       c4
		  c5	   j	    pvertexlist	      overtexlist
		  xp	   yp	    zp	     zp1      atri     fpt
		  spt	   tpt	    cpt	     inter1   inter2   inter3
		  rtri	   rfpt	    rspt     rtpt     x0       x1
		  x2	   y0	    y1	     y2	      z1       z2
		 )			;----------------- ;; Example:
;;;  (get_Z_3Df (ssget '((0 . "3dface")))
;;;	     (getpoint "\nSpecify the point ->>")
;;;  )
					;----------------- (vl-load-com) ;-----------------
  (setq	acadObject   (vlax-get-acad-object)
	acadDocument (vla-get-ActiveDocument acadObject)
	modelspace   (vla-get-ModelSpace acadDocument)
	acadlayers   (vla-get-layers acadDocument)
	acadblock    (vla-get-Blocks acadDocument)
	util	     (vla-get-utility acadDocument)
  )
					;----------------------------------------------------------
  (defun midpoint (a b)
    (polar a (angle a b) (* (distance a b) 0.5))
  )
					;----------------------------------------------------------
  (defun butlast (l) (reverse (cdr (reverse l))))
					;----------------------------------------------------------
  (setq	objlist	'()
	Cobj nil
	coords nil
	coordslist
	 '()
	zc nil
  )
  (setq
    objlist (mapcar 'vlax-ename->vla-object
		    (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	    )
  )
  (setq i objlist)
  (repeat (length objlist);objlist es la lista del conjunto
    (setq cobj (car i)
	  i    (cdr i)
    )
    (setq coord
	   (vlax-safearray->list
	     (vlax-variant-value (vlax-get-property cobj 'Coordinates))
	   )
    )
    (setq coordslist (cons coord coordslist))
  )
					;-----------------------------
  (setq	xc (car ptclick)
	yc (cadr ptclick)
  )
					;====================================== (= 1. 1.2 2.0)
  (if (and ptclick ss)
    (if (not
	  (vl-some '(lambda(l / c x y c n)
		      (while (and (not c) (setq x (nth (setq n (if n (+ n 3) 0)) l)))
			(setq c (equal (list x (setq y (nth (1+ n) l))) (list (car ptclick) (cadr ptclick)) 1e-8))
		        c
		      )
		    )
		   coordslist
	  )
	)
      (progn (setq i coordslist)
	     (setq pfacelist '())
	     (setq ofacelist '())
	     (repeat (length i)
	       (setq aface (car i)
		     i	   (cdr i)
	       )
	       (setq c0	(car aface)
		     c1	(cadr aface)
		     c2	(caddr aface)
		     c3	(cadddr aface)
		     c4	(cadddr (cdr aface))
		     c5	(cadddr (cddr aface))
	       )
	       (if (and (= c0 c3) (= c1 c4) (= c2 c5))
		 (setq j 3)
		 (setq j 0)
	       )
	       (setq pvertexlist '())
	       (setq overtexlist '())
	       (repeat (- (length aface) 3)
		 (repeat j (setq aface (cdr aface)))
		 (setq xp  (car aface)
		       yp  (cadr aface)
		       zp  0.0
		       zp1 (caddr aface)
		 )
		 (setq pvertexlist (cons (list xp yp zp) pvertexlist))
		 (setq overtexlist (cons (list xp yp zp1) overtexlist))
		 (setq j 3)
	       )
	       (setq pvertexlist (reverse pvertexlist))
	       (setq overtexlist (reverse overtexlist))
	       (setq pfacelist (cons pvertexlist pfacelist))
	       (setq ofacelist (cons overtexlist ofacelist))
	     )
	     (repeat (length pfacelist)
	       (setq atri      (car pfacelist)
		     pfacelist (cdr pfacelist)
	       )
	       (setq fpt (car atri)
		     spt (cadr atri)
		     tpt (caddr atri)
	       )
	       (setq cpt (inters fpt (midpoint spt tpt) spt (midpoint fpt tpt))
		     cpt (butlast cpt)
	       )
	       (setq inter1 (inters ptclick cpt fpt spt)
		     inter2 (inters ptclick cpt spt tpt)
		     inter3 (inters ptclick cpt tpt fpt)
	       )
	       (setq rtri      (car ofacelist)
		     ofacelist (cdr ofacelist)
	       )
	       (setq rfpt (car rtri)
		     rspt (cadr rtri)
		     rtpt (caddr rtri)
	       )
	       (if (and (null inter1) (null inter2) (null inter3))
		 (progn	(setq x0 (car rfpt)
			      y0 (cadr rfpt)
			      z0 (caddr rfpt)
			      x1 (- (car rspt) x0)
			      y1 (- (cadr rspt) y0)
			      z1 (- (caddr rspt) z0)
			      x2 (- (car rtpt) x0)
			      y2 (- (cadr rtpt) y0)
			      z2 (- (caddr rtpt) z0)
			)
			(setq numerator	 (+ (* (- xc x0) (- (* y1 z2) (* y2 z1)))
					    (* (- yc y0) (- (* x2 z1) (* x1 z2)))
					 )
			      denomiator (- (* x2 y1) (* x1 y2))
			)
			(if (not (zerop denomiator))
			  (setq zc (+ z0 (/ numerator denomiator)))
			)
		 )
	       )
	     )
      )
      (setq zc (last ptclick))
    )
  )
  zc
)

Edited Friday at 12:15 PM by GLAVCVS

Friday at 10:48 AM

Basically, I've made a call to 'vl-some' to check if 'ptclick' matches any of the points in 'coordslist'. If so, the code jumps to '(setq zc (last ptclick))' and terminates the function.

Friday at 08:19 PM

Thank you very much!

Edited Friday at 10:18 PM by dilan

Friday at 10:30 PM

On 3/28/2025 at 10:48 AM, GLAVCVS said:

Basically, I've made a call to 'vl-some' to check if 'ptclick' matches any of the points in 'coordslist'. If so, the code jumps to '(setq zc (last ptclick))' and terminates the function.

Expand

I'm not entirely clear on this. If my point lands on a vertex of a 3D face where both the first and second sets are present... do I only get the Z-value from one of the sets? I need to get the Z-coordinate from the vertices of 3D faces in both the first and second sets. These 3D face vertices share the same X and Y coordinates but have different Z-values.

example sets of 3d faces.dwgFetching info...

Edited Friday at 10:35 PM by dilan

Friday at 11:00 PM

In a 3DFACE mesh, each face is supposed to coincide in xyz on each of its sides with the neighboring 3DFACEs.
The code returns the z of the first vertex it finds because it assumes that if there is another, it will be identical.

Friday at 11:07 PM

On 3/28/2025 at 11:00 PM, GLAVCVS said:

In a 3DFACE mesh, each face is supposed to coincide in xyz on each of its sides with the neighboring 3DFACEs.
The code returns the z of the first vertex it finds because it assumes that if there is another, it will be identical.

Expand

But in my case it is not identical. Yes, they are identical in each set, but not identical across sets. I always get the same Z, although the sets are different.

Edited Friday at 11:10 PM by dilan

Friday at 11:33 PM

And then: what is the correct criterion?

Saturday at 02:12 AM

On 3/28/2025 at 11:33 PM, GLAVCVS said:

And then: what is the correct criterion?

Expand

Please take a look at an example of how I use the function get_Z_3Df, maybe I'm doing something wrong in the logic :

(if 
(setq mylist '((77466.4 54356.4 0.0) (77476.0 54372.1 0.0) (77511.8 54397.5 0.0) (77483.9 54397.3 0.0) (77508.9 54430.2 0.0) (77550.0 54446.6 0.0) (77433.6 54311.8 0.0))
      ss1 (ssget '((0 . "3dface")))
	  ss2 (ssget '((0 . "3dface")))
); end of serq
(foreach itm mylist
(setq val1 (get_Z_3Df ss1 itm)
      val2 (get_Z_3Df ss2 itm)
)
         (setq LST_COORD 
				    (cons 
					    (list 
						    (car itm)
							(cadr itm)
							(cond
                                    ((and val1 val2)(+ (caddr itm)(- val1 val2))) ; - >> This solution works if the function (get_Z_3Df) 
									                                              ; returns the Z coordinate from the first set of 
																				  ; 3D faces and the second set. 
									                                              ; But if this point is at the 
																				  ; vertex of the 3D faces (as in my drawing), 
																				  ; then I don't get the Z difference between 
																				  ; these two sets of 3D faces. 
																				  ; If the point is inside the 3D face, 
																				  ; the equation works. I can't understand why.
                                    ((and (not val1) (not val2))(caddr itm))
                                    ((not val1) (caddr itm))
                                    (t (caddr itm))
                            ); end of cond
						); end of list
						  LST_COORD ; ->> I need to get a list of my points. If a projection exists for both sets of 3D faces, 
						            ; I add the Z difference to the point's elevation. 
									; If there's no projection on at least one set, I leave the elevation unchanged.
					); end of cons
			); end of setq
)
); end of if

Saturday at 03:09 AM

Dilan

In your first post code, if the point is on a vertex or on a edge, one of 3 inters functions will return a point, so your program stops calculating the elevation, because, later, the if function checks for null inters. There is another way, for sure. I'll give it a try later.

The pvertexlist and overtexlist lists are not correct built. Some of the points are nil. I think it's easier to extract the coordinates from ENAME, from 10, 11, 12 and 13 dxf codes, then remove the duplicate. A 3dface has always 4 coordinates, but if it shows just 3, that means 1 is duplicated. More, you consider the duplicate pair the first and the second vertex, but in reality it can be any pair.

In the dxf, you have multiple 3dface duplicates. Is it really necessary? I guess the sample ij just a small part of a larger project and you are comparing each point with each face. Eliminating the duplicates will improve the speed quite a lot.

BTW, calling the function for each point with the same selection, and then extracting the coordinates from each face over and over again, it is also time consuming.

Saturday at 04:22 AM

On 3/29/2025 at 3:09 AM, Stefan BMR said:

BTW, calling the function for each point with the same selection, and then extracting the coordinates from each face over and over again, it is also time consuming.

Expand

Yes, you are right. My list can have 100 thousand points or more, and analyzing each point for each set of 3D faces takes a lot of time. In the drawing, 3D faces are duplicated only by the X and Y coordinates. But the coordinates of the Z vertices of these 3D faces are different, the difference can be minimal, sometimes one of the three vertices may be the same, but the other two are different. And I have to calculate this minimal difference or count 0 if the vertices are in the same coordinate Z in the vertices of the 3D faces. It turns out that each set of 3D faces is created by one point, but for each set, the coordinate of the Z points is different or sometimes equal.

Edited Saturday at 04:46 AM by dilan

Saturday at 07:03 AM

This may be useful. A different method. The p1 is from your list, the 3d is a 3dface.

; get point on 3dface 
; By Alan H Oct 2021

(defun c:pt3dface ( )
(while (setq p1 (getpoint "\npick point"))
(setq p2 (mapcar '+ p1 (list 0.0 0.0 10000.0)))
(setq 3d (entget (car (entsel "\npick 3dface"))))
(setq p3 (cdr (assoc 10 3d)))
(setq p4 (cdr (assoc 11 3d)))
(setq p5 (cdr (assoc 12 3d)))
(setq  zpt  (cal "ilp(p1,p2,p3,p4,p5)"))
(if (= zpt nil)
(princ "\nPoint not on 3dface")
(alert (strcat "\nPoint is X= " (rtos (car zpt) 2 3)  " Y= "  (rtos (cadr zpt) 2 3) " Z= " (rtos (caddr zpt) 2 3)))
)
(setq zpt nil)
)
(princ)
)
(c:pt3dface)

Saturday at 09:41 AM

I hadn't realized.
There's a problem with the 3DFACEs in your drawing. Normally, the first and last points coincide. But in your drawing, the first and second points coincide.
If you want to solve it you can use this code:

(defun c:ajusta3DFACEs (/ cj ent lstent p1 p2 p3 p4 n r la c)
  (if (setq cj (ssget "x" '((0 . "3DFACE"))))
    (while (setq ent (ssname cj (setq n (if n (1+ n) 0))))
      (setq lstent (entget ent) r nil la nil c 9)
      (foreach l lstent
	(if (member (car l) '(10 11 12 13))
	  (if la
	    (if (not (equal (cdr l) (cdr la) 1e-8))
	      (setq r (cons (cons (setq c (1+ c)) (cdr l)) r) la l)
	    )
	    (setq r (cons (cons (setq c (1+ c)) (cdr l)) r) la l)
	  )
	)
      )
      (if (= (length r) 3)
	(entmod
	  (append
	    (reverse (cdr (member (assoc 10 lstent) (reverse lstent))))
	    (reverse (cons (cons 13 (cdr (last r))) r))
	    (list (assoc 70 lstent))
	  )
	)
      )
    )
  )
)

Edited Saturday at 09:51 AM by GLAVCVS

Saturday at 01:04 PM

But this isn't the only anomaly in your drawing.
As @Stefan BMR says, there are many duplicate 3DFACEs. And sometimes, the Z coordinates don't even match.
With all this, your interpolation algorithm becomes unreliable because it depends on the 3DFACE you choose to determine the Z value.
Therefore, I think you need to first filter your drawing to eliminate duplicate 3DFACEs using some criteria.

Edited Saturday at 01:05 PM by GLAVCVS

Sign In

Get the Z coordinate from a set of 3D faces at the specified point's coordinates

Recommended Posts

dilan

GLAVCVS

GLAVCVS

dilan

dilan

GLAVCVS

dilan

GLAVCVS

dilan

Stefan BMR

dilan

BIGAL

GLAVCVS

GLAVCVS

Join the conversation

Tutorials

Forums

Activity