Interpolate 3D polyline at every vertex

March 10, 2015

I am looking for an interpolation lisp that would work like this:

Select: first point (on 3D polyline) and set elevation

Select: second point (on 3D polyline) and set elevation

And then linearly interpolate the elevations at every vertex.

Can someone help me with this?

March 11, 2015

Show us how you derived 10.000, 16.753, 24.195, 34.309, 42.753, 50.000 as "interpolated" value, How do you manually get this value?

Are we looking at a plan view or a section?

EDIT: Definitely plan view

March 11, 2015

I manually get this value to convert the 3D polyline to profile and then stretch all the vertext to the pline 0,10 0,50.

I hope I am clear enough!

Pascal

3D polyline interpolate elevations.dwg

March 11, 2015

I see, there's not too much math involved then . I thinks its easy, the only thing i'm not sure about is the placement of the interpoalted values , are you telling me there are no TEXT entities to start with?

March 11, 2015

Hi

Try this lisp. The selection process is a little bit trickier: The end of the polyline nearest to the selection point is the first elevation point.

It is important where you pick the polyline AND the order of elevations.

(defun c:test ( / l2p e p h1 h2 h l_tot a d s lp)
(defun l2p (l) (if l (cons (list (car l) (cadr l) (caddr l)) (l2p (cdddr l)))))
(if
 (and
   (setq e (entsel "\nSelect 3DPolyline near to the desired start: "))
   (setq p (cadr e))
   (eq (cdr (assoc 0 (entget (setq e (car e))))) "POLYLINE")
   (= 8 (logand (cdr (assoc 70 (entget e))) 8 ))
   (setq h1 (getdist "\nStart Elevation: "))
   (setq h2 (getdist "\nEnd Elevation: "))
   )
 (progn
   (setq lp (l2p (vlax-get (vlax-ename->vla-object e) 'coordinates)))
   (if
     (> (vlax-curve-getdistatpoint e (vlax-curve-getclosestpointtoprojection e p (getvar 'viewdir)))
        (/ (vlax-curve-getdistatpoint e (vlax-curve-getendpoint e)) 2.0)
        )
     (setq h h1 h1 h2 h2 h)
     )
   (setq lp (mapcar '(lambda (x) (list (car x) (cadr x) 0.0)) lp)
         l_tot (apply '+ (mapcar 'distance lp (cdr lp)))
         a (/ (- h2 h1) l_tot)
         d 0
         s (car lp)
         lp (mapcar
              '(lambda (x / p)
                 (setq d (+ d (distance s x))
                       p (list (car x) (cadr x) (+ h1 (* d a)))
                       s x)
                 p
               )
               lp
            )
   )
   (vlax-put (vlax-ename->vla-object e) 'coordinates (apply 'append lp))
   )
 )
(princ)
)

Edited May 27, 2021 by Stefan BMR
Fixed code formating error

March 11, 2015

oh man! Stefan beat me to it.

Very nice

What i'm formulating has the general idea as yours , you took it one step further by modifying the vertices to reflect the correct Z value. Maybe that was what the OP is wanting all along, the posts did say "the heights [RED] are for info only"

kudos to Stefan

BTW: (getvar 'viewdir);

March 11, 2015

Stefan,

It works perfect. You did a great job and thanks. It will save me a lot of time with this task that I have to do. :notworthy:

Thanks for your replies (Stefan and pBe)

Pascal

March 11, 2015

Good for you, its all Stefan though.

September 19, 2018

On 3/11/2015 at 6:00 PM, Stefan BMR said:
Hi

Try this lisp. The selection process is a little bit trickier: The end of the polyline nearest to the selection point is the first elevation point.

It is important where you pick the polyline AND the order of elevations.
(defun c:test ( / l2p e p h1 h2 h l_tot a d s lp)
(defun l2p (l) (if l (cons (list (car l) (cadr l) (caddr l)) (l2p (cdddr l)))))
(if
 (and
   (setq e (entsel "\nSelect 3DPolyline near to the desired start: "))
   (setq p (cadr e))
   (eq (cdr (assoc 0 (entget (setq e (car e))))) "POLYLINE")
   (= 8 (logand (cdr (assoc 70 (entget e))) )
   (setq h1 (getdist "\nStart Elevation: "))
   (setq h2 (getdist "\nEnd Elevation: "))
   )
 (progn
   (setq lp (l2p (vlax-get (vlax-ename->vla-object e) 'coordinates)))
   (if
     (> (vlax-curve-getdistatpoint e (vlax-curve-getclosestpointtoprojection e p (getvar 'viewdir)))
        (/ (vlax-curve-getdistatpoint e (vlax-curve-getendpoint e)) 2.0)
        )
     (setq h h1 h1 h2 h2 h)
     )
   (setq lp (mapcar '(lambda (x) (list (car x) (cadr x) 0.0)) lp)
         l_tot (apply '+ (mapcar 'distance lp (cdr lp)))
         a (/ (- h2 h1) l_tot)
         d 0
         s (car lp)
         lp (mapcar
              '(lambda (x / p)
                 (setq d (+ d (distance s x))
                       p (list (car x) (cadr x) (+ h1 (* d a)))
                       s x)
                 p
               )
               lp
            )
   )
   (vlax-put (vlax-ename->vla-object e) 'coordinates (apply 'append lp))
   )
 )
(princ)
)
Buna ziua,

Am rugămintea sa ma ajutați și pe mine cu o chestiune...am o mulțime de polinii 3D care NU au Elevație (cota 0) în anumite Vertex-uri.

Menționez ca pe poliniile 3D respective am puncte normale cu elevație Z. Ce doresc defapt ...sa selectez punctele cu elevație și apoi polinia 3D exitenta pe care vreau sa o corectez (sa treaca fiecare vertex al poliliniei 3D prin fiecare punct selectat) .

Am atasat si un fisier pt exemplificare...

Va rămân profund recunoscător pentru timpul acordat .

Mulțumesc anticipat.

Drawing4000.dwg

September 19, 2018

1st

Hello

I request you to help me with a chestiune...am a lot of 3d polinii that do not have elevation (quota 0) in certain vertices.

I mention that on Poliniile 3d I have normal points with elevation Z. What I really want... to select the points with elevation and then Polinia 3d Exitenta that I want to correct (pass each vertex of the 3d Polyliner through each selected point).

I have attached a file for example...

I will remain deeply grateful for your time.

Thanks in advance.

In english used google translate

If points are on the pline then you can use ssget "F" option, you pick the pline and get the co-ordinates making a list then using (ssget "F" list) it should find the points. You make a new list of the point co-ords plus start and end draw a new 3d pline.

Need some time to code. Some one else may post soon.

În cazul în care punctele sunt pe pline apoi puteţi utiliza ssget "f " opţiune, alegeţi pline şi de a lua co-coordonatele a face o listă, apoi folosind (ssget "f " lista) ar trebui să găsească puncte. Tu a face o nouă listă de Point co-ORDS plus scrobeală şi sfîrşit a trage un nou 3D pline.

Nevoie de ceva timp pentru a codului. Unii alţii pot posta în curând.

Edited September 19, 2018 by BIGAL

September 19, 2018

4 minutes ago, BIGAL said:

1st

Hello

I request you to help me with a chestiune...am a lot of 3d polinii that do not have elevation (quota 0) in certain vertices.

I mention that on Poliniile 3d I have normal points with elevation Z. What I really want... to select the points with elevation and then Polinia 3d Exitenta that I want to correct (pass each vertex of the 3d Polyliner through each selected point).

I have attached a file for example...

I will remain deeply grateful for your time.

Thanks in advance.

In english

If points are on the pline then you can use ssget "F" option, you pick the pline and get the co-ordinates making a list then using (ssget "F" list) it should find the points. You make a new list of the point co-ords plus start and end draw a new 3d pline.

Need some time to code. Some one else may post soon.

În cazul în care punctele sunt pe pline apoi puteţi utiliza ssget "f " opţiune, alegeţi pline şi de a lua co-coordonatele a face o listă, apoi folosind (ssget "f " lista) ar trebui să găsească puncte. Tu a face o nouă listă de Point co-ORDS plus scrobeală şi sfîrşit a trage un nou 3D pline.

Nevoie de ceva timp pentru a codului. Unii alţii pot posta în curând.

Thank you for your answer ... BIGAL
Still, you can help me with a code on this.

September 19, 2018

Try this uses a plain pline for the direction.


; pline co-ords example
; By Alan H
(defun getcoords (ent)
  (vlax-safearray->list
    (vlax-variant-value
      (vlax-get-property
    (setq obj (vlax-ename->vla-object ent))
    "Coordinates"
      )
    )
  )
)
 
 ; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(defun co-ords2xy ( / len I numb)
(setq len (length co-ords))
(if (= (vla-get-ObjectName obj) "AcDb3dPolyline")
(progn
(setq numb (/ len 3))
(setq odd "yes")
)
(progn
(setq numb (/ len 2))
(setq odd "no")
)
)
 (setq I 0)
(setq co-ordsxy '())
(repeat numb
(cond 
((= odd "yes") (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords)(nth (+ I 2) co-ords) ))(setq I (+ I 3)))
((= odd "no" ) (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))(setq I (+ I 2)))
)
(setq co-ordsxy (cons xy co-ordsxy))
)
)

; program starts here
(defun c:plverts ( / k x y z )
(setq ent (car (entsel "\nplease pick pline")))
(setq co-ords (getcoords ent))
(co-ords2xy) ; list of 2d or 3d points making pline
(command "erase" ent "")
(setq ss (ssget "f" co-ordsxy (list (cons 0 "POINT"))))
(setq lst '())
(repeat (setq x (sslength ss))
(setq entpt (ssname ss (setq x (- x 1))))
(setq pt (assoc 10 (entget entpt)))
(setq pt (list (nth 1 pt)(nth 2  pt)(nth 3 pt)))
(setq lst (cons pt lst ))
)
(setq oldsnap (getvar "osmode"))
(setvar "osmode" 0)
(setq oldzsnap (getvar "osnapz"))
(setvar "osnapz" 0)
(command "_3dpoly")
(while (= (getvar "cmdactive") 1 ) 
(repeat (setq x (length lst))
(command (nth (setq x (- x 1)) lst))
)
(command "")
)
(setvar "osmode" oldsnap)
(setvar "osnapz" oldzsnap)
)
(c:plverts)

September 19, 2018

5 minutes ago, BIGAL said:

Try this uses a plain pline for the direction.


; pline co-ords example
; By Alan H
(defun getcoords (ent)
  (vlax-safearray->list
    (vlax-variant-value
      (vlax-get-property
    (setq obj (vlax-ename->vla-object ent))
    "Coordinates"
      )
    )
  )
)
 
 ; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(defun co-ords2xy ( / len I numb)
(setq len (length co-ords))
(if (= (vla-get-ObjectName obj) "AcDb3dPolyline")
(progn
(setq numb (/ len 3))
(setq odd "yes")
)
(progn
(setq numb (/ len 2))
(setq odd "no")
)
)
 (setq I 0)
(setq co-ordsxy '())
(repeat numb
(cond 
((= odd "yes") (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords)(nth (+ I 2) co-ords) ))(setq I (+ I 3)))
((= odd "no" ) (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))(setq I (+ I 2)))
)
(setq co-ordsxy (cons xy co-ordsxy))
)
)

; program starts here
(defun c:plverts ( / k x y z )
(setq ent (car (entsel "\nplease pick pline")))
(setq co-ords (getcoords ent))
(co-ords2xy) ; list of 2d or 3d points making pline
(command "erase" ent "")
(setq ss (ssget "f" co-ordsxy (list (cons 0 "POINT"))))
(setq lst '())
(repeat (setq x (sslength ss))
(setq entpt (ssname ss (setq x (- x 1))))
(setq pt (assoc 10 (entget entpt)))
(setq pt (list (nth 1 pt)(nth 2  pt)(nth 3 pt)))
(setq lst (cons pt lst ))
)
(setq oldsnap (getvar "osmode"))
(setvar "osmode" 0)
(setq oldzsnap (getvar "osnapz"))
(setvar "osnapz" 0)
(command "_3dpoly")
(while (= (getvar "cmdactive") 1 ) 
(repeat (setq x (length lst))
(command (nth (setq x (- x 1)) lst))
)
(command "")
)
(setvar "osmode" oldsnap)
(setvar "osnapz" oldzsnap)
)
(c:plverts)

Hello BIGALL,

the code is good ... but it has a small error, I attached an example file.

Drawing3.dwg

September 19, 2018

Salut Mihai

I've made something but it might be slow in large drawings.

In your sample, the points are not exact in the vertexes XY position, so I had to use a precision factor. Use max 3 digits for your dwg.

Send me a PM if you want or if you need more info.

;Stefan M. - 19.09.2018
(defun c:fix3dpoly ( / *error* acobj acdoc layers
                    l2p 2dp
                    ss i en el vo o la
                    p_list pl_list pts co elev fuzz
                    )
  (vl-load-com)
  (setq acobj (vlax-get-acad-object)
        acdoc (vla-get-activedocument acobj)
        layers (vla-get-layers acdoc)
  )

  (if (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark acdoc))
  
  (defun *error* (msg)
    (and msg
      (not (wcmatch (strcase msg) "*EXIT*,*CANCEL*,*ABORT*"))
      (princ (strcat "\nERROR: " msg))
    )
    
    (if (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark acdoc))
    (princ)
  )

  (defun l3p (l)
    (if l
      (cons
        (list (car l) (cadr l) (caddr l))
        (l3p (cdddr l))
      )
    )
  )

  (defun 2dp (p) (list (car p) (cadr p) 0.0))

  (or *fuzz* (setq *fuzz* 3))
  
  (if
    (and
      (setq ss (ssget '((0 . "POLYLINE,POINT"))))
      (progn
        (initget 4)
        (setq *fuzz*
          (cond
            ((getint (strcat "\nSpecificati precizia ca numar de zecimale <" (itoa *fuzz*) ">: ")))
            (*fuzz*)
          )
        )
      )
    )
    (progn
      (setq fuzz (/ 1.0 (expt 10 *fuzz*)))
      (repeat (setq i (sslength ss))
        (setq en (ssname ss (setq i (1- i)))
              el (entget en)
              vo (vlax-ename->vla-object en)
              o  (cdr (assoc 0 el))
              la (vla-item layers (cdr (assoc 8 el)))
        )
        (cond
          ((eq o "POINT")
           (setq p_list (cons (cdr (assoc 10 el)) p_list))
          )
          ((or
             (eq (vla-get-layeron la) :vlax-false)
             (eq (vla-get-lock la) :vlax-true)
           )
          )
          ((eq (vla-get-objectname  vo) "AcDb3dPolyline")
           (setq pl_list (cons vo pl_list))
          )
        )
      )
      (foreach e pl_list
        (setq pts (l3p (vlax-get e 'coordinates))
              co  (vla-copy e))
        (vlax-put co 'coordinates (apply 'append (mapcar '2dp pts)))
        (setq elev (vl-remove-if-not
                     '(lambda (x)
                        (equal (2dp x) (vlax-curve-getclosestpointto co (2dp x)) fuzz)
                      )
                     p_list
                   )
        )   
        (setq pts
          (mapcar
           '(lambda (x)
              (cond
                ((vl-some '(lambda (a) (if (equal (2dp a) (2dp x) fuzz) a)) elev))
                (x)
              )
            )
            pts
          )
        )
        (vlax-put e 'coordinates (apply 'append pts))
        (vla-delete co)
      )
    )
  )
  (*error* nil)
  (princ)
)

Edited September 20, 2018 by Stefan BMR
Logand expression fixed

September 20, 2018

Alternative solution:

(defun c:3dPoly_FixZ ( / doc elev enm fuzz i obj pt ss)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if
    (and
      (setq enm (car (entsel)))
      (setq obj (vlax-ename->vla-object enm))
      (or
        (= "AcDb3dPolyline" (vla-get-objectname obj))
        (prompt "\nError: not a 3D polyline ")
      )
    )
    (progn
      (setq i -1)
      (setq fuzz 0.001)
      (repeat (+ (fix (vlax-curve-getendparam obj)) (if (= :vlax-true (vla-get-closed obj)) 0 1))
        (setq pt (vlax-safearray->list (vlax-variant-value (vla-get-coordinate obj (setq i (1+ i))))))
        (if
          (and
            (setq ss
              (ssget
                "_X"
                (list
                  '(410 . "Model")
                  '(0 . "POINT")
                  '(-4 . "<AND")
                    '(-4 . ">,>,*") (cons 10 (mapcar '- pt (list fuzz fuzz 0.0)))
                    '(-4 . "<,<,*") (cons 10 (mapcar '+ pt (list fuzz fuzz 0.0)))
                  '(-4 . "AND>")
                )
              )
            )
            (/=
              (caddr pt)
              (setq elev (caddr (vlax-get (vlax-ename->vla-object (ssname ss 0)) 'coordinates)))
            )
          )
          (vla-put-coordinate obj i (vlax-3d-point (list (car pt) (cadr pt) elev)))
        )
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

September 20, 2018

I think one missing thing in

@Stefan BMR code

This :

(= (logand 8 (getvar 'undoctl)))

Should be :

(= 8 (logand 8 (getvar 'undoctl)))

This is all I saw for lacks, maybe there are more, but I haven't tested it...

M.R.

September 20, 2018

Hello to all, I want to thank you for your time to solve my problem. I come with the mentioning that all three codes are going very well. I tested each one

Thank you again for your involvement in my problem

September 20, 2018

1 hour ago, marko_ribar said:
I think one missing thing in

@Stefan BMR code

This :
(= (logand 8 (getvar 'undoctl)))
Should be :
(= 8 (logand 8 (getvar 'undoctl)))
This is all I saw for lacks, maybe there are more, but I haven't tested it...

M.R.

OOPS

Fixed above

May 27, 2021

On 3/12/2015 at 12:00 AM, Stefan BMR said:

Hi

Try this lisp. The selection process is a little bit trickier: The end of the polyline nearest to the selection point is the first elevation point.

It is important where you pick the polyline AND the order of elevations.


(defun c:test ( / l2p e p h1 h2 h l_tot a d s lp)
(defun l2p (l) (if l (cons (list (car l) (cadr l) (caddr l)) (l2p (cdddr l)))))
(if
 (and
   (setq e (entsel "\nSelect 3DPolyline near to the desired start: "))
   (setq p (cadr e))
   (eq (cdr (assoc 0 (entget (setq e (car e))))) "POLYLINE")
   (= 8 (logand (cdr (assoc 70 (entget e))) )
   (setq h1 (getdist "\nStart Elevation: "))
   (setq h2 (getdist "\nEnd Elevation: "))
   )
 (progn
   (setq lp (l2p (vlax-get (vlax-ename->vla-object e) 'coordinates)))
   (if
     (> (vlax-curve-getdistatpoint e (vlax-curve-getclosestpointtoprojection e p (getvar 'viewdir)))
        (/ (vlax-curve-getdistatpoint e (vlax-curve-getendpoint e)) 2.0)
        )
     (setq h h1 h1 h2 h2 h)
     )
   (setq lp (mapcar '(lambda (x) (list (car x) (cadr x) 0.0)) lp)
         l_tot (apply '+ (mapcar 'distance lp (cdr lp)))
         a (/ (- h2 h1) l_tot)
         d 0
         s (car lp)
         lp (mapcar
              '(lambda (x / p)
                 (setq d (+ d (distance s x))
                       p (list (car x) (cadr x) (+ h1 (* d a)))
                       s x)
                 p
               )
               lp
            )
   )
   (vlax-put (vlax-ename->vla-object e) 'coordinates (apply 'append lp))
   )
 )
(princ)
)

Hi! Thank you for this LISP. I was trying to use this and in command bar it says: ; error: malformed list on input.

Can you please look into this? Thank you.

May 27, 2021

9 hours ago, chubbyowl said:

Hi! Thank you for this LISP. I was trying to use this and in command bar it says: ; error: malformed list on input.

Can you please look into this? Thank you.

Fixed in the original post.

Sign In

Interpolate 3D polyline at every vertex

Recommended Posts

ghostware

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

pBe

ghostware

pBe

Stefan BMR

pBe

ghostware

pBe

mihaibantas

BIGAL

mihaibantas

BIGAL

mihaibantas

Stefan BMR

Roy_043

marko_ribar

mihaibantas

Stefan BMR

chubbyowl

Stefan BMR

Join the conversation

Tutorials

Forums

Activity