Interpolate vertex elevation on 3D polylines

[Dexterel]

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:

[john.uhden]

Looks more like you need to figure out how that is happening in the first place. Maybe if the Zs are wrong then the Xs and Ys can't be trusted either. Might you want to just remove the errant vertices?

[stevor]

Why not just post some of your dwg?

A few of the POLYLINEs, presumably all "AcDb3dPolyline"s

should get you some code to get estimated elevations.

Acad 2000 format, no reactors, no irrelevant data,

will get you the most.

[Dexterel]

Thank you for your interest in my problem.

I receive a lot of data from which I need to extract 3d polylines.

My workflow is:

Create a point database form all objects with elevation (text, points, blocks)

Create a drawing with all the 2D line work. Assign elevation -999.00 to all and convert them to 3D poly.

Raise all vertices of the 3D polylines that are on a point to point elevation (see Example-3dpoly.dwg).

Now comes the problem. I need a lisp that interpolates the missing elevation (elevation -999.00) on the 3D polylines.

I need all the vertices on the 3D polylines. Removing vertices is not an option.

[john.uhden]

I could write that for you when I find the time.

[stevor]

Attached may be a start for revising the Z values.

[Dexterel]

Hello,

The provided LSP gives me the following error (this is command prompt from AutoCAD):

Command: ap APPLOAD 3DPoly-Mod-Zs.lsp successfully loaded.
Command:
 _RevNegZ,  of -900:  Do : ucs
Current ucs name:  *WORLD*
Specify origin of UCS or [Face/NAmed/OBject/Previous/View/World/X/Y/Z/ZAxis] <World>: w
Command:
 Sel 3DPoly
Can't reenter LISP.
*Invalid selection*
Expects a point or Last
 Sel 3DPoly (here I get to select a 3D polyline, after selecting nothing happens)
Command: Command:

Also I have a question, how to start this LSP without uploading the file again (alias to start the lisp)?

[phanaem · Accepted solution]

Salut Dragos

This one is working on your dwg sample.

It require lwpolylines in your drawing, elevation as dtext in "BT_puho_hoogte" layer. The insertion point of the texts (only x and y) must be exactly on the lwpolyline's vertexes. The z value is not important because the content of the text is used instead.

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

You need to load the lisp file only once in each drawing. If you want to automatic load the lisp, run appload. In the dialog box click the Statup Suite then Add button. Navigate to the file location and add it to the startup suit. This way the file is loaded each time you open a file.

There are many solutions for auto load a lisp, but I think this is the easiest one for a beginner.

Send me a PM if you have troubles.

[Anonymous]

Hello,

The provided lisp is very good, it dose the job.

Small thing I need to be wary of:

If a polyline has curves first converted to 3D poly and back to poly (to insert vertices on curves).

The close property of a polyline is not transfer to resulting 3D polyline. Workaround explode closed polylines and join them back.

Thank you so much for your work Phanaem, it is very appreciated.

PS: Dau o bere Stefane 😄

[phanaem]

Salut Dragos

Try this one, untested. It should keep closed/open property and it inserts 4 additional points on bulged polylines.

If 4 is not enough, just tell me what you prefer, a specific distance or a specific angle.

Download attached file and change extension to .lsp

[Dexterel]

Salut,

The provided lisp dose not create any elevation on new 3d poly. All vertices have elevation 0.
I don't think any additional points are needed just if its possible to keep the closed property.
I tested your initial lisp and works rally good, the only thing is not perfect is the closed property. Don't change anything just add if possible the closed property.

[phanaem · Accepted solution]

I think is fixed now.

[Dexterel]

Thank you. It works very good.

[CADaSchtroumpf · Accepted solution]

Hi,

An another way with your drawing  "Example-3dpoly.dwg"

(vl-load-com)
(defun encadre (num lst / inf sup)
  (foreach n lst
    (cond
      ((< n num)
       (setq inf
        (if inf
          (max n inf)
          n
        )
       )
      )
      ((> n num)
       (setq sup
        (if sup
          (min n sup)
          n
        )
       )
      )
    )
  )
  (list inf sup)
)
(defun c:interpol_3dpoly ( / js AcDoc Space alti n obj ename pr dist_cum l_pt l_pos nwl_pt l_2int l_base pt_start pt_end inter_dist first next nw_pt)
  (princ "\nSelect poly3D.")
  (while
    (null
      (setq js
        (ssget
          (list
            (cons 0 "*POLYLINE")
            (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
            (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
            (cons -4 "<NOT")
              (cons -4 "&") (cons 70 112)
            (cons -4 "NOT>")
          )
        )
      )
    )
    (princ "\nEmpty or isn't valid poly3!")
  )
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (= 1 (getvar "CVPORT"))
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
  )
  (setq alti (getreal "\nAltitude default points to recalculate? <0.0>: "))
  (if (not alti) (setq alti 0.0))
  (repeat (setq n (sslength js))
    (setq
      obj (ssname js (setq n (1- n)))
      ename (vlax-ename->vla-object obj)
      pr -1
      dist_cum 0.0
      l_pt '()
      l_pos '()
      nwl_pt '()
      l_2int '()
      l_base '()
    )
    (repeat (fix (vlax-curve-getEndParam ename))
      (setq
        pt_start (vlax-curve-GetPointAtParam ename (setq pr (1+ pr)))
        pt_end (vlax-curve-GetPointAtParam ename (1+ pr))
        l_pt (cons (cons (1+ pr) (list pt_start dist_cum)) l_pt)
        l_pos (cons (1+ pr) l_pos)
        inter_dist (distance (list (car pt_start) (cadr pt_start)) (list (car pt_end) (cadr pt_end)))
        dist_cum (+ inter_dist dist_cum)
      )
    )
    (setq l_pt (cons (cons (1+ (1+ pr)) (list pt_end dist_cum)) l_pt))
    (foreach n (reverse l_pt)
      (if (eq (caddr (cadr n)) alti)
        (setq l_2int (cons n l_2int))
        (setq l_base (cons n l_base))
      )
    )
    (cond
      ((> (length l_base) 1)
        (foreach n (reverse l_pt)
          (cond
            ((eq (caddr (cadr n)) alti)
              (setq pos (encadre (car n) (mapcar 'car l_base)))
              (if (not (car pos))
                (setq pos (list (cadr pos) (cadr (encadre (cadr pos) (mapcar 'car l_base)))))
              )
              (if (not (cadr pos))
                (setq pos (list (car (encadre (car pos) (mapcar 'car l_base))) (car pos)))
              )
              (setq
                first (assoc (car pos) l_base)
                next (assoc (cadr pos) l_base)
                nw_pt
                (subst
                  (list
                    (car (cadr n))
                    (cadr (cadr n))
                    (+
                      (caddr (cadr first))
                      (*
                        (/ (- (caddr (cadr next)) (caddr (cadr first))) (- (caddr next) (caddr first)))
                        (- (caddr n) (caddr first))
                      )
                    )
                  )
                  (cadr n)
                  n
                )
              )
            )
            (T (setq nw_pt n))
          )
          (setq nwl_pt (cons nw_pt nwl_pt))
        )
        (vla-put-Layer (vlax-invoke Space 'Add3dPoly (apply 'append (reverse (mapcar 'cadr nwl_pt)))) (vla-get-Layer ename))
        (vla-delete ename)
      )
    )
  )
  (prin1)
)

[Dexterel]

Hello,

Thank you for the lisp.

I didn't give it an thoroughly testing, but it looks ok.

[john.uhden]

Unless I am mistaken, it appears that you are interpolating using 3D distances when you should be converting them to 2D.

[CADaSchtroumpf]

No, I have used 2D distance! The (caddr) of point aren't taken

inter_dist (distance (list (car pt_start) (cadr pt_start)) (list (car pt_end) (cadr pt_end)))

[john.uhden]

I see. My apologies. Nice work!

[ВeekeeCZ]

Hi guys, yours routines come handy to me. Thanks for it. Unfortunately I found some issues on my sample.

@phanaem

Please see attached drawing. Would be possible to add the possibility to count with heights that lay on polyline but not at vertex? It's very common case to me. And second, if the height lays on polyline and at vertex, but in between of arc segments (probably), then it will cut the end of 3dpoly.

I would be grateful if that will work... it saves me a lot of time to dig into yours algorithms to adjust this... Thanks in advance.

[Dexterel]

Check: elevation should be: dtext in "BT_puho_hoogte" layer
dtext should be in a vertex of the pline to count