0 Members and 1 Guest are viewing this topic.
A haxers way of doing it Maybe pick the two closest contours, draw a 3dpolyline between them (snapping to nearest), then add a point on that 3d polyline snapping to nearest. You will see the elevation of the point.
Looking for something like this ?
The accuracy of the elevation will not be very good, typically the contours are generated off a TIN, then smoothed so the contours themselves are not spot on. But in answer to your question yes that is possible.
If you have the triangulation that generated the contourFind your Z on the the faces of the TIN.
Quote from: ronjonp on February 24, 2015, 01:34:04 PMA haxers way of doing it Maybe pick the two closest contours, draw a 3dpolyline between them (snapping to nearest), then add a point on that 3d polyline snapping to nearest. You will see the elevation of the point.Thank you for replay my friend Ron,How Can I do that?I have no idea to be honest. Could you help me please?
Quote from: FABRICIO28 on February 24, 2015, 01:40:42 PMQuote from: ronjonp on February 24, 2015, 01:34:04 PMA haxers way of doing it Maybe pick the two closest contours, draw a 3dpolyline between them (snapping to nearest), then add a point on that 3d polyline snapping to nearest. You will see the elevation of the point.Thank you for replay my friend Ron,How Can I do that?I have no idea to be honest. Could you help me please?See attached.
Fabricio,Look at the thread :Triangulation Re-visitedymg
Command: FIELDField Category: Object >> Select your pointProperty = PositionUncheck X,YMake sure OSNAPZ is set to 0 when drafting.
If you need contour cross line to 3D polyline
test
FABRICIO28, This lisp create 3Dpolyline from contour.
;;; This file writes Level of a point as per Selected Contours(defun c:SpotElevfromContours () (vl-load-com) ;;---------------- ;; Functions ;;---------------- (defun gc:distinctFuzz (lst fuzz) (if lst (cons (car lst) (gc:distinctFuzz (vl-remove-if '(lambda (x) (equal x (car lst) fuzz)) lst) fuzz)) ) ) (defun CurrentZoomWindow (/ a b c d x) (setq b (getvar "viewsize") c (car (getvar "screensize")) d (cadr (getvar "screensize")) a (* b (/ c d)) x (trans (getvar "viewctr") 1 2) c (list (- (car x) (/ a 2.0)) (- (cadr x) (/ b 2.0)) 0.0) d (list (+ (car x) (/ a 2.0)) (+ (cadr x) (/ b 2.0)) 0.0) c (trans c 2 1) d (trans d 2 1) ) (list c d) ) (defun GetElevPoint (glpt sscont / app mind elev muSetpt1 mySetpt2 foundcontours rectsize increment minx miny maxx maxy pt1 pt2 pt3 pt4 selset ncont entcont ptcont dd fg lenset lencnt found val1 elev1 dist1 ent1 lin1 obj1 intcnt frstelev elev2 dist2 ) (setq app (vlax-get-acad-object)) (setq mind 0) (setq elev "") (setq mySetpt1 (list)) (setq mySetpt2 (list)) (setq foundcontours 0) (setq rectsize 200.0) (setq increment 20.0) (while (eq foundcontours 0) (setq minx (- (car glpt) rectsize)) (setq maxx (+ (car glpt) rectsize)) (setq miny (- (cadr glpt) rectsize)) (setq maxy (+ (cadr glpt) rectsize)) (setq pt1 (list minx miny 0.0)) (setq pt2 (list maxx miny 0.0)) (setq pt3 (list maxx maxy 0.0)) (setq pt4 (list minx maxy 0.0)) (vla-zoomwindow app (vlax-3d-point pt1) (vlax-3d-point pt3)) (if (setq selset (ACET-SS-INTERSECTION sscont (ssget "_CP" (list pt1 pt2 pt3 pt4) '((0 . "*POLYLINE"))))) (setq foundcontours 1) ) (setq rectsize (+ rectsize increment)) ) (repeat (setq ncont (sslength selset)) (setq entcont (ssname selset (setq ncont (1- ncont)))) (setq elev (vla-get-elevation (vlax-ename->vla-object entcont))) (setq ptcont (vlax-curve-getclosestpointto entcont glpt)) (setq ptcont (list (car ptcont) (cadr ptcont) (caddr glpt))) (setq dd (distance ptcont glpt)) (setq mySetpt1 (append mySetpt1 (list (list elev dd ptcont entcont)))) ) (setq fg (vl-sort mySetpt1 '(lambda (e1 e2) (< (cadr e1) (cadr e2))))) (setq lenset (length fg)) (setq lencnt 0) (setq found 0) (setq frstelev nil) (while (< lencnt lenset) (setq val1 (nth lencnt fg)) (setq elev1 (car val1)) (setq dist1 (cadr val1)) (setq pt1 (caddr val1)) (setq ent1 (cadddr val1)) (command "LINE" pt1 glpt "") (setq lin1 (entlast)) (setq obj1 (vlax-ename->vla-object lin1)) (setq intcnt (CountUniqueIntersections obj1 selset (caddr glpt))) (if (and (<= intcnt 1) (not (equal frstelev elev1 0.01))) (progn (setq found (1+ found)) (setq frstelev elev1) (setq mySetpt2 (append mySetpt2 (list (list elev1 dist1)))) (vla-delete obj1) ) (progn (vla-delete obj1)) ) (if (= found 2) (progn (setq lencnt (+ lenset 1))) (progn (setq lencnt (1+ lencnt))) ) ) (if (= (length mySetpt2) 2) (progn (setq elev1 (car (car mySetpt2))) (setq dist1 (cadr (car mySetpt2))) (setq elev2 (car (cadr mySetpt2))) (setq dist2 (cadr (cadr mySetpt2))) (setq elev (+ (* (/ (- elev2 elev1) (+ dist2 dist1)) dist1) elev1)) ) (progn (setq elev (car (car mySetpt2)))) ) elev ) (defun CountUniqueIntersections (obj1 sscont ht / cntb unlst ncont2 ncont2cnt entcont2 obj2 ui l) (setq cntb 0) (setq unlst (list)) (setq ncont2 (sslength sscont)) (setq ncont2cnt 0) (while (< ncont2cnt ncont2) (setq entcont2 (ssname sscont ncont2cnt)) (setq obj2 (vlax-ename->vla-object entcont2)) (setq ui (vla-get-elevation obj2)) (vla-put-elevation obj2 ht) (if (setq l (vlax-invoke obj1 'intersectwith obj2 acExtendNone)) (setq unlst (append unlst (list (list l)))) ) (vla-put-elevation obj2 ui) (setq unlst (gc:distinctFuzz unlst 0.0001)) (if (> (length unlst) 1) (setq ncont2cnt (1+ ncont2)) (setq ncont2cnt (1+ ncont2cnt)) ) ) (length unlst) );;;;;;;;; ;| ---------------------------------- ACTUAL PROGRAM STARTED --------------------------------------- |; (setq oldsnapmode (getvar "snapmode")) (setq oldosmode (getvar "osmode")) (setq oldlayer (getvar "clayer")) (setq oldorthomode (getvar "orthomode")) (if (not (tblsearch "LAYER" "TEMP1")) (command "_.-layer" "M" "TEMP1" "C" "1" "" "L" "Continuous" "" "LW" 0.05 "" "") ) (setvar "clayer" "TEMP1") (prompt "\nSelect Contours") (if (setq ssc (ssget "_:L" '((0 . "*POLYLINE")))) (progn (setq app (vlax-get-acad-object)) (setq fcnt 1) (while (setq glpt (getpoint "Select Point (or Enter to Exit) : ")) (setq vext (CurrentZoomWindow)) (setvar "cmdecho" 0) (setvar "snapmode" 0) (setvar "osmode" 0) (setvar "orthomode" 0) (setq elev (GetElevPoint glpt ssc)) (entmake ;Start entity make (list ;Start list (cons 0 "TEXT") ;Entity type (cons 8 "ELEVATION") ;Layer name (cons 10 glpt) ;Text first base point (cons 11 glpt) ;Text second base point (cons 40 3) ;Text height (cons 1 (rtos elev 2 2)) ;Text string (cons 50 0) ;Text rotation (cons 41 1.0) ;Relative x scale factor (cons 51 0.0) ;Oblique angle (cons 7 "Standard") ;Text style (cons 71 0) ;Text generation flag (cons 72 1) ;Horizontal justification flag center ;(cons 11 TFBP) ;Text first base point ;(cons 210 EXDR) ;Extrusion direction (Needed for 3D) (cons 73 2) ;Middle justification ) ;End list ) (vla-zoomwindow app (vlax-3d-point (car vext)) (vlax-3d-point (cadr vext))) ) ) ) (setvar "snapmode" oldsnapmode) (setvar "orthomode" oldorthomode) (setvar "osmode" oldosmode) (setvar "cmdecho" 1) (if (tblsearch "LAYER" oldlayer) (setvar "clayer" oldlayer) ) (princ))
My Code : Code: [Select];;; This file writes Level of a point as per Selected Contours(defun c:SpotElevfromContours () (vl-load-com) ;;---------------- ;; Functions ;;---------------- (defun gc:distinctFuzz (lst fuzz) (if lst (cons (car lst) (gc:distinctFuzz (vl-remove-if '(lambda (x) (equal x (car lst) fuzz)) lst) fuzz)) ) ) (defun CurrentZoomWindow (/ a b c d x) (setq b (getvar "viewsize") c (car (getvar "screensize")) d (cadr (getvar "screensize")) a (* b (/ c d)) x (trans (getvar "viewctr") 1 2) c (list (- (car x) (/ a 2.0)) (- (cadr x) (/ b 2.0)) 0.0) d (list (+ (car x) (/ a 2.0)) (+ (cadr x) (/ b 2.0)) 0.0) c (trans c 2 1) d (trans d 2 1) ) (list c d) ) (defun GetElevPoint (glpt sscont / app mind elev muSetpt1 mySetpt2 foundcontours rectsize increment minx miny maxx maxy pt1 pt2 pt3 pt4 selset ncont entcont ptcont dd fg lenset lencnt found val1 elev1 dist1 ent1 lin1 obj1 intcnt frstelev elev2 dist2 ) (setq app (vlax-get-acad-object)) (setq mind 0) (setq elev "") (setq mySetpt1 (list)) (setq mySetpt2 (list)) (setq foundcontours 0) (setq rectsize 200.0) (setq increment 20.0) (while (eq foundcontours 0) (setq minx (- (car glpt) rectsize)) (setq maxx (+ (car glpt) rectsize)) (setq miny (- (cadr glpt) rectsize)) (setq maxy (+ (cadr glpt) rectsize)) (setq pt1 (list minx miny 0.0)) (setq pt2 (list maxx miny 0.0)) (setq pt3 (list maxx maxy 0.0)) (setq pt4 (list minx maxy 0.0)) (vla-zoomwindow app (vlax-3d-point pt1) (vlax-3d-point pt3)) (if (setq selset (ACET-SS-INTERSECTION sscont (ssget "_CP" (list pt1 pt2 pt3 pt4) '((0 . "*POLYLINE"))))) (setq foundcontours 1) ) (setq rectsize (+ rectsize increment)) ) (repeat (setq ncont (sslength selset)) (setq entcont (ssname selset (setq ncont (1- ncont)))) (setq elev (vla-get-elevation (vlax-ename->vla-object entcont))) (setq ptcont (vlax-curve-getclosestpointto entcont glpt)) (setq ptcont (list (car ptcont) (cadr ptcont) (caddr glpt))) (setq dd (distance ptcont glpt)) (setq mySetpt1 (append mySetpt1 (list (list elev dd ptcont entcont)))) ) (setq fg (vl-sort mySetpt1 '(lambda (e1 e2) (< (cadr e1) (cadr e2))))) (setq lenset (length fg)) (setq lencnt 0) (setq found 0) (setq frstelev nil) (while (< lencnt lenset) (setq val1 (nth lencnt fg)) (setq elev1 (car val1)) (setq dist1 (cadr val1)) (setq pt1 (caddr val1)) (setq ent1 (cadddr val1)) (command "LINE" pt1 glpt "") (setq lin1 (entlast)) (setq obj1 (vlax-ename->vla-object lin1)) (setq intcnt (CountUniqueIntersections obj1 selset (caddr glpt))) (if (and (<= intcnt 1) (not (equal frstelev elev1 0.01))) (progn (setq found (1+ found)) (setq frstelev elev1) (setq mySetpt2 (append mySetpt2 (list (list elev1 dist1)))) (vla-delete obj1) ) (progn (vla-delete obj1)) ) (if (= found 2) (progn (setq lencnt (+ lenset 1))) (progn (setq lencnt (1+ lencnt))) ) ) (if (= (length mySetpt2) 2) (progn (setq elev1 (car (car mySetpt2))) (setq dist1 (cadr (car mySetpt2))) (setq elev2 (car (cadr mySetpt2))) (setq dist2 (cadr (cadr mySetpt2))) (setq elev (+ (* (/ (- elev2 elev1) (+ dist2 dist1)) dist1) elev1)) ) (progn (setq elev (car (car mySetpt2)))) ) elev ) (defun CountUniqueIntersections (obj1 sscont ht / cntb unlst ncont2 ncont2cnt entcont2 obj2 ui l) (setq cntb 0) (setq unlst (list)) (setq ncont2 (sslength sscont)) (setq ncont2cnt 0) (while (< ncont2cnt ncont2) (setq entcont2 (ssname sscont ncont2cnt)) (setq obj2 (vlax-ename->vla-object entcont2)) (setq ui (vla-get-elevation obj2)) (vla-put-elevation obj2 ht) (if (setq l (vlax-invoke obj1 'intersectwith obj2 acExtendNone)) (setq unlst (append unlst (list (list l)))) ) (vla-put-elevation obj2 ui) (setq unlst (gc:distinctFuzz unlst 0.0001)) (if (> (length unlst) 1) (setq ncont2cnt (1+ ncont2)) (setq ncont2cnt (1+ ncont2cnt)) ) ) (length unlst) );;;;;;;;; ;| ---------------------------------- ACTUAL PROGRAM STARTED --------------------------------------- |; (setq oldsnapmode (getvar "snapmode")) (setq oldosmode (getvar "osmode")) (setq oldlayer (getvar "clayer")) (setq oldorthomode (getvar "orthomode")) (if (not (tblsearch "LAYER" "TEMP1")) (command "_.-layer" "M" "TEMP1" "C" "1" "" "L" "Continuous" "" "LW" 0.05 "" "") ) (setvar "clayer" "TEMP1") (prompt "\nSelect Contours") (if (setq ssc (ssget "_:L" '((0 . "*POLYLINE")))) (progn (setq app (vlax-get-acad-object)) (setq fcnt 1) (while (setq glpt (getpoint "Select Point (or Enter to Exit) : ")) (setq vext (CurrentZoomWindow)) (setvar "cmdecho" 0) (setvar "snapmode" 0) (setvar "osmode" 0) (setvar "orthomode" 0) (setq elev (GetElevPoint glpt ssc)) (entmake ;Start entity make (list ;Start list (cons 0 "TEXT") ;Entity type (cons 8 "ELEVATION") ;Layer name (cons 10 glpt) ;Text first base point (cons 11 glpt) ;Text second base point (cons 40 3) ;Text height (cons 1 (rtos elev 2 2)) ;Text string (cons 50 0) ;Text rotation (cons 41 1.0) ;Relative x scale factor (cons 51 0.0) ;Oblique angle (cons 7 "Standard") ;Text style (cons 71 0) ;Text generation flag (cons 72 1) ;Horizontal justification flag center ;(cons 11 TFBP) ;Text first base point ;(cons 210 EXDR) ;Extrusion direction (Needed for 3D) (cons 73 2) ;Middle justification ) ;End list ) (vla-zoomwindow app (vlax-3d-point (car vext)) (vlax-3d-point (cadr vext))) ) ) ) (setvar "snapmode" oldsnapmode) (setvar "orthomode" oldorthomode) (setvar "osmode" oldosmode) (setvar "cmdecho" 1) (if (tblsearch "LAYER" oldlayer) (setvar "clayer" oldlayer) ) (princ))
Happy to help.Whatvever LISP I have learnt, full credit goes to this forum and its members such as LEE MAC, CAB, RONJONP, BLACKBOX, JOHN KAUL, ALANJT and many more. Sorry if i missed some names.