Jump to content

Interpolate 3D polyline at every vertex


ghostware

Recommended Posts

  • Replies 22
  • Created
  • Last Reply

Top Posters In This Topic

  • pBe

    4

  • Stefan BMR

    4

  • mihaibantas

    4

  • ghostware

    3

Top Posters In This Topic

Posted Images

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 :)

Link to comment
Share on other sites

I see, there's not too much math involved then :D. 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?

Link to comment
Share on other sites

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 by Stefan BMR
Fixed code formating error
Link to comment
Share on other sites

oh man! Stefan beat me to it. :lol:

 

Very nice :thumbsup:

 

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);

Link to comment
Share on other sites

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. :D:notworthy:

 

Thanks for your replies (Stefan and pBe)

 

Pascal

Link to comment
Share on other sites

  • 3 years later...
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

Link to comment
Share on other sites

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 by BIGAL
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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)

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 by Stefan BMR
Logand expression fixed
Link to comment
Share on other sites

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)
)

 

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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 😀

Link to comment
Share on other sites

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

Link to comment
Share on other sites

  • 2 years later...
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.

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...