I have many 3d polylines that are missing elevation in some vertices.
I need a lisp that checks the multiple 3d polylines and interpolate between vertices with elevation greater than -100.00, similar to flatten and constant grade as shown bellow:
The lisp should also check if the start and end points elevations are valid (more than -100.00) if not it should change them to the next good elevation on the 3D polyline.
The end result should look like this:
Hello @phanaem
A question please
If I have the closed POLYLINE and the height is not on the first VERTEX
As shown in the picture and drawing
Is it possible to modify the code for that?
;interpolare polylinii 3D
;Stefan M. - 05.09.2016
(defun c:test ( / *error* acdoc ssp sst i e l elev p z) (vl-load-com)
(setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark acdoc)
(defun *error* (msg)
(and
msg
(not (wcmatch (strcase msg) "*EXIT*,*QUIT*,*CANCEL*,*BREAK*"))
(princ (strcat "\nError: " msg))
)
(vla-endundomark acdoc)
(princ)
)
(if
(and
(setq ssp (ssget ":L" '((0 . "LWPOLYLINE"))))
(setq sst (ssget "_X" '((0 . "TEXT") (8 . "BT_puho_hoogte"))))
)
(progn
(repeat (setq i (sslength sst))
(setq e (entget (ssname sst (setq i (1- i))))
p (assoc (if (and (zerop (cdr (assoc 72 e))) (zerop (cdr (assoc 73 e)))) 10 11) e)
z (atof (cdr (assoc 1 e)))
l (cons (list (cdr p) z) l)
)
(entmod
(mapcar
'(lambda (a)
(if
(member (car a) '(10 11))
(list (car a) (cadr a) (caddr a) z)
a
)
)
e
)
)
)
(repeat (setq i (sslength ssp))
(setq e (ssname ssp (setq i (1- i)))
elev (cdr (assoc 38 (entget e)))
p (mapcar
'(lambda (a / b d z)
(setq b (trans (list (car a) (cadr a) elev) e 0)
d (vlax-curve-getdistatpoint e b)
z (vl-some
'(lambda (c)
(if
(equal 0.0 (distance a (car c)) 1e-8)
(cadr c)
)
)
l
)
)
(list (car b) (cadr b) z d)
)
(mapcar 'cdr (vl-remove-if '(lambda (a) (/= (car a) 10)) (entget e)))
)
p (interpolare p)
)
(make_3d_poly p (assoc 8 (entget e)))
)
)
)
(*error* nil)
(princ)
)
(defun interpolare (pct / d1 d2 p1 p2 p3 z1 z2)
(if
(and
(setq p1 (vl-some '(lambda (a) (if (caddr a) a)) pct))
(setq p2 (vl-some '(lambda (a) (if (caddr a) a)) (cdr (member p1 pct))))
)
(mapcar
'(lambda (p / z1 z2 d1 d2 p3)
(setq z1 (caddr p1) d1 (cadddr p1)
z2 (caddr p2) d2 (cadddr p2)
)
(if
(caddr p)
(progn
(cond
((< (cadddr p) d2)
(setq p1 p)
)
((= (cadddr p) d2)
(if
(setq p3 (vl-some '(lambda (a) (if (caddr a) a)) (cdr (member p2 pct))))
(setq p1 p p2 p3)
)
)
)
(list (car p) (cadr p) (caddr p))
)
(list (car p) (cadr p) (/ (+ (* z2 (- (cadddr p) d1)) (* z1 (- d2 (cadddr p)))) (- d2 d1)))
)
)
pct
)
(mapcar '(lambda (a) (list (car a) (cadr a) (if z1 (caddr z1) 0.0))) pct)
)
)
(defun make_3d_poly (lst la)
(entmakex
(list
'(0 . "POLYLINE")
la
'(100 . "AcDbEntity")
'(100 . "AcDb3dPolyline")
'(70 . 8)
)
)
(foreach x lst
(entmakex
(list
'(0 . "VERTEX")
'(100 . "AcDbEntity")
'(100 . "AcDbVertex")
'(100 . "AcDb3dPolylineVertex")
(cons 10 x)
'(70 . 32)
)
)
)
(entmakex '((0 . "SEQEND")))
)drawing attachment
thank you In advance
