Thread title adjusted.


Registered forum members do not see this ad.
Sorry about the miss-spelt title! should be "Low points and high points on a 3d poly"!
Does anyone have a routine to put low points and high points on a 3d poly?
I have a 3d poly which goes up and down (various sags and crests) over half a mile. I need a routine that puts a cross and the text "HP" for a high point on the crest and "LP" for the low point on a sag in varying locations along this polyline.
I know this one is going to be a challenge as the 3d polylines are not curves but straights.
Anyone heard of a routine like this or have one?
Thread title adjusted.
It's nice to be nice, but sometimes is nicer to be evil!.
![]()
Tip: Please do not PM or email me with CAD questions - use the forums, you'll get an answer sooner.
Here would be a basic starting point:
Some limits or thing to address:Code:(defun c:extz3dp (/ ss i en ed vn vd pl maxz minz) ;;;ARG -> point text_value text_size (defun make_tick (p v s) (entmake (list (cons 0 "LINE") (cons 10 (polar p (* pi 0.25) s)) (cons 11 (polar p (* pi 1.25) s)))) (entmake (list (cons 0 "LINE") (cons 10 (polar p (* pi 0.75) s)) (cons 11 (polar p (* pi 1.75) s)))) (entmake (list (cons 0 "TEXT")(cons 1 v)(cons 6 "BYLAYER") (cons 7 "STANDARD")(cons 8 "0") (cons 10 p)(cons 11 p)(cons 39 0.0) (cons 40 s)(cons 41 1.0)(cons 62 256)(cons 72 4)))) (and (setq ss (ssget "X" (list (cons 0 "POLYLINE") (cons 66 1) (if (getvar "CTAB") (cons 410 (getvar "CTAB")) (cons 67 (- 1 (getvar "TILEMODE")))) (cons -4 "&") (cons 70 8) ))) (setq i (sslength ss)) (while (not (minusp (setq i (1- i)))) (setq en (ssname ss i) ed (entget en) vn (entnext en) vd (entget vn)) (while (and (= "VERTEX" (cdr (assoc 0 vd))) (= 32 (cdr (assoc 70 vd)))) (setq pl (cons (cdr (assoc 10 vd)) pl) vn (entnext vn) vd (entget vn)))) (foreach v pl (if (not maxz) (setq maxz v)) (if (not minz) (setq minz v)) (if (>= (caddr v) (caddr maxz)) (setq maxz v)) (if (<= (caddr v) (caddr minz)) (setq minz v))) (make_tick minz "LP" 2) (make_tick maxz "HP" 2)) (prin1))
What happens if there are 2 or more points that have the min or max z values
Filter only 3DPOLYINEs
Uses VERTEX control points only
A (ssget) filter to skip curved fitted 3DPOLYs would be nice
Adjust the call to make_tick for size
Adjust make_tick TEXT values to your needs
-David
R12 (Dos) - A2K
That doesn't surprise me <g>
Maybe this will help:
Code:(defun c:extz3dp (/ ss i en ed vn vd pl maxz minz) ; (*-debug-* 9 "extz3pd") ;;;ARG -> point text_value text_size (defun make_tick (p v s) (entmake (list (cons 0 "LINE") (cons 10 (polar p (* pi 0.25) s)) (cons 11 (polar p (* pi 1.25) s)))) (entmake (list (cons 0 "LINE") (cons 10 (polar p (* pi 0.75) s)) (cons 11 (polar p (* pi 1.75) s)))) (entmake (list (cons 0 "TEXT")(cons 1 v)(cons 6 "BYLAYER") (cons 7 "STANDARD")(cons 8 "0") (cons 10 p)(cons 11 p)(cons 39 1e-8) (cons 40 s)(cons 62 256)(cons 72 4)))) (if (setq ss (ssget "X" (list (cons 0 "POLYLINE") (if (getvar "CTAB") (cons 410 (getvar "CTAB")) (cons 67 (- 1 (getvar "TILEMODE")))) (cons -4 "<NOT") (cons -4 "&") (cons 70 4) (cons -4 "NOT>") (cons -4 "&") (cons 70 8)))) (progn (setq i (sslength ss)) (while (not (minusp (setq i (1- i)))) (setq en (ssname ss i) ed (entget en) vn (entnext en) vd (entget vn) pl nil) (while (= "VERTEX" (cdr (assoc 0 vd))) (setq pl (cons (cdr (assoc 10 vd)) pl) vn (entnext vn) vd (entget vn))) (setq maxz (list (car pl)) minz (list (car pl))) (foreach v pl (cond ((equal v (car maxz) 1e-8)) ((> (caddr v) (caddr (car maxz))) (setq maxz (list v))) ((equal (caddr v) (caddr (car maxz)) 1e-8) (setq maxz (cons v maxz))) ((equal v (car minz) 1e-8)) ((< (caddr v) (caddr (car minz))) (setq minz (list v))) ((equal (caddr v) (caddr (car minz)) 1e-8) (setq minz (cons v minz))))) (foreach p minz (make_tick p "LP" 2)) (foreach p maxz (make_tick p "HP" 2))))) (prin1))
-David
R12 (Dos) - A2K
This should mark all the Peaks and Troughs on your polyline:
Hope this helps,Code:;; High-Low Point ~ Lee McDonnell (Lee Mac) ~ 01.12.2009 (defun c:Hi_Low (/ mk_pt ent i pt dif t1 t2) (vl-load-com) (defun mk_pt (p txt) (entmake (list (cons 0 "LINE") (cons 10 (polar p (/ pi 4.) 2.)) (cons 11 (polar p (/ (* 5 pi) 4.) 2.)))) (entmake (list (cons 0 "LINE") (cons 10 (polar p (/ (* 3 pi) 4.) 2.)) (cons 11 (polar p (/ (* 7 pi) 4.) 2.)))) (entmake (list (cons 0 "TEXT") (cons 40 (getvar "TEXTSIZE")) (cons 1 txt) (cons 10 p) (cons 72 1) (cons 73 1) (cons 11 p)))) (while (progn (setq ent (car (entsel "\nSelect 3D-Polyline: "))) (cond ( (eq 'ENAME (type ent)) (if (eq "POLYLINE" (cdr (assoc 0 (entget ent)))) (if (and (not (eq 8 (logand 8 (cdr (assoc 70 (entget ent)))))) (eq 4 (logand 4 (cdr (assoc 70 (entget ent)))))) (princ "\n** Object Must not have Arc Vertices **") (progn (setq i (1- (vlax-curve-getStartParam ent))) (while (<= (setq i (1+ i)) (vlax-curve-getEndParam ent)) (setq pt (vlax-curve-getPointatParam ent i) dif (cond ( (eq (vlax-curve-getStartParam ent) i) (setq t2 (- (caddr pt) (caddr (vlax-curve-getPointatParam ent (+ i 0.5))))) (if (not (zerop t2)) t2)) ( (eq (vlax-curve-getEndParam ent) i) (setq t2 (- (caddr pt) (caddr (vlax-curve-getPointatParam ent (- i 0.5))))) (if (not (zerop t2)) t2)) (t (setq t1 (- (caddr pt) (caddr (vlax-curve-getPointatParam ent (+ i 0.5)))) t2 (- (caddr pt) (caddr (vlax-curve-getPointatParam ent (- i 0.5))))) (if (not (or (zerop t2) (minusp (/ t1 t2)))) t2)))) (if dif (mk_pt (vlax-curve-getPointatParam ent i) (if (minusp dif) "LP" "HP")))) t)) (princ "\n** Object Must be a 3D-Polyline **")))))) (princ))
Lee
Lee Mac Programming
With Mathematics there is the possibility of perfect rigour, so why settle for less?
Just another Swamper


Lee Mac, that was an awsome bit of clever programming there. 10/10![]()
Registered forum members do not see this ad.
Thanks Iain![]()
Lee Mac Programming
With Mathematics there is the possibility of perfect rigour, so why settle for less?
Just another Swamper
Bookmarks