Leaderboard

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.

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 )

Glad to help : ) Here's another that is not a block. (defun c:foo (/ p) (while (setq p (getpoint "\\nPick a point: ")) (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(67 . 0) '(8 . "L-MVIEW") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 129) '(38 . 0) '(39 . 0) (cons 10 p) '(40 . 40) '(41 . 40) '(42 . 0) '(91 . 0) (cons 10 (setq p (mapcar '+ '(1000 0) p))) '(40 . 0) '(41 . 0) '(42 . 0) '(91 . 0) (cons 10 (setq p (mapcar '+ '(0 400) p))) '(40 . 40) '(41 . 40) '(42 . 0) '(91 . 0) (cons 10 (setq p (mapcar '+ '(-1000 0) p))) '(40 . 0) '(41 . 0) '(42 . 0) '(91 . 0) ) ) ) (princ) )

Well done An alternative would be to move (setq rtn (cons ent rtn)) outside of the if statement, e.g.: (defun getblockentities ( blk / ent enx rtn ) (if (setq ent (tblobjname "block" blk)) (while (setq ent (entnext ent)) (setq rtn (cons ent rtn) enx (entget ent) ) (if (= "INSERT" (cdr (assoc 0 enx))) (setq rtn (append (reverse (getblockentities (cdr (assoc 2 enx)))) rtn)) ) ) ) (reverse rtn) )