Convert 3D Poly to 2D Poly using Average Elevation

[ArchD]

I'm looking for a lisp that converts a 3D Polyline to a 2D Polyline set to the average elevation of the original 3D Polyline elevations.

Any help finding one would greatly be appreciated. 

[Ranjit_Singh · Accepted solution]

---

@ArchD wrote:

....... converts a 3D Polyline to a 2D Polyline set to the average elevation ..........

---

Hi @ArchD, maybe start with below code. No testing and error trap but I imagine you can add that yourself.

(defun c:somefunc  (/ ent ent2 etdata lst cl)
 (setq ent2 (car (entsel "\nSelect 3D poly:"))
       cl   (cdr (assoc 70 (entget ent2)))
       ent  ent2)
 (while (and (setq ent (entnext ent)) (/= "SEQEND" (cdr (assoc 0 (setq etdata (entget ent))))))
  (setq lst (cons (assoc 10 etdata) lst)))
 (entmake (append (list '(0 . "LWPOLYLINE")
                        '(100 . "AcDbEntity")
                        '(100 . "AcDbPolyline")
                        (cons 38 (/ (apply '+ (mapcar 'cadddr lst)) (length lst))))
                  (list (cons 90 (length lst)) (cons 70 (+ 128 (logand 1 cl))))
                  lst))
 (entdel ent2)
 (princ))

[_gile]

Hi,

Maybe you can get some inspiration from this quite old one from my tool box.

;; Flatten a 3d polyline into a lwpolyline
(defun c:FlatPline (/ *error* 3d-coord->pt-lst doc opt del pts ss alt zlst pl)
  (vl-load-com)
  
  (defun *error* (msg)
    (and (/= msg "Function cancelled")
         (princ (strcat "\nError: " msg))
    )
    (and ss (vla-delete ss))
    (vla-EndUndoMark doc)
    (princ)
  )

;;; 3d-coord->pt-lst Converts a flat coordinates list into a point list.
;;; (3d-coord->pt-lst '(1.0 2.0 3.0 4.0 5.0 6.0)) -> ((1.0 2.0 3.0) (4.0 5.0 6.0))

(defun 3d-coord->pt-lst (lst)
  (if lst
    (cons (list (car lst) (cadr lst) (caddr lst))
          (3d-coord->pt-lst (cdddr lst))
    )
  )
)
  
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if (ssget '((0 . "POLYLINE") (-4 . "&") (70 . 8)))
    (progn
      (vla-StartUndoMark doc)
      (initget "maXimum miNimum Average")
      (setq opt (cond
                  ((getkword "\Elevation of the polyline plane [maXimum/miNimum/Average] <A>: "))
                  (T "Average")
                )
      )
      (initget "Yes No")
      (setq del (cond
                  ((getkword "\nDelete the 3d polyline source? [Yes/No] <N>: "))
                  (T "No")
                )
      )
      (vlax-for p (setq ss (vla-get-ActiveSelectionSet doc))
        (setq pts (3d-coord->pt-lst (vlax-get p 'Coordinates))
              zlst (mapcar 'caddr pts)
              alt (cond
                    ((= opt "maXimum")
                     (apply 'max zlst)
                    )
                    ((= opt "miNimum")
                     (apply 'min zlst)
                    )
                    (T (/ (apply '+ zlst) (length pts)))
                  )
              pl  (vlax-invoke
                    (vla-get-ModelSpace doc)
                    'addLightWeightPolyline
                    (apply
                      'append
                      (mapcar
                        '(lambda (p)
                           (setq p (trans p 0 (trans '(0 0 1) 1 0 T)))
                           (list (car p) (cadr p))
                         )
                        pts
                      )
                    )
                  )
        )
        (vla-put-elevation pl alt)
        (vla-put-Closed pl (vla-get-Closed p))
        (if (= del "Yes")
          (vla-delete p)
        )
      )
      (vla-delete ss)
      (vla-EndUndoMark doc)
    )
  )
  (princ)
)

[ArchD]

Thanks Ranjit, you are appreciated as always.

[john.uhden]

I like it!

I am just wondering if the OP wants a weighted average based on the length between vertices, or just a simple average of all the Zs.

A 100 init long 3DPOLY might have only 4 vertices with Zs of 1, 100, 100, and 1, with the first and last segments being only 1 unit long each, wherein the weighted average would be 99+, not 50.5.

BTW, can you really use vla-delete on a selection set object these days (or any days)?  I am pretty sure you can't use vla-delete on a PICKSET, right?

[ArchD]

I never really thought about that but a weighted average like you mentioned would be a more accurate elevation for what I'm doing. 

[Ranjit_Singh · Accepted solution]

Maybe like this. Minimal testing

(defun c:somefunc  (/ ent ent2 etdata lst cl td dis lst2)
 (setq ent2 (car (entsel "\nSelect 3D poly:"))
       cl   (assoc 70 (entget ent2))
       ent  ent2
       td   0)
 (while (and (setq ent (entnext ent)) (/= "SEQEND" (cdr (assoc 0 (setq etdata (entget ent))))))
  (setq lst (cons (assoc 10 etdata) lst)))
 (setq lst2 lst
       lst  (mapcar 'cdr lst))
 (entmake
  (append (list '(0 . "LWPOLYLINE")
                '(100 . "AcDbEntity")
                '(100 . "AcDbPolyline")
                (cons 38
                      (/ (apply '+
                                (mapcar '(lambda (x y)
                                          (* (/ (+ (caddr x) (caddr y)) 2)
                                             (progn (setq td (+ td (setq dis (distance (reverse (cdr (reverse x))) (reverse (cdr (reverse y)))))))
                                                    dis)))
                                        (if (= 1 (logand 1 (cdr cl)))
                                         (setq lst (append lst (list (car lst))))
                                         lst)
                                        (cdr lst)))
                         td)))
          (list (cons 90 (length lst2)) cl)
          lst2))
 (entdel ent2)
 (princ))

[Kent1Cooper · Accepted solution]

---

@ArchD wrote:

I'm looking for a lisp that converts a 3D Polyline to a 2D Polyline set to the average elevation of the original 3D Polyline elevations.  .... 

---

Here's another kind-of interesting way to do it, using VLA Properties instead of entity data, so it doesn't need to mess with the fact that each vertex of a 3DPolyline is its own entity.  Interestingly, you can impose a list of Coordinates on a Polyline object this way even without the number of vertices matching, so this just draws a little starting Polyline of one segment, and then imposes the XY-only list of Coordinates from the 3DPoly on that, and the average Elevation from the Z coordinates.  [It's not a weighted average affected by segment lengths, as discussed in recent posts.]

(defun C:3DLWAvg ; = 3D polyline to LW polyline at Average elevation
  (/ 3dpoly 3dcoords 3dpobj n XYs Zs lwp)
  (setq
    3dpoly (car (entsel "\n3DPolyline to make Average-elevation LWPolyline from: "))
    3dcoords (vlax-get (setq 3dpobj (vlax-ename->vla-object 3dpoly)) 'Coordinates)
    n -1
  ); setq
  (repeat (/ (length 3dcoords) 3); for each vertex's worth of XYZ coordinates,
    (setq
      XYs (append XYs (list (nth (setq n (1+ n)) 3dcoords))); X coordinate
      XYs (append XYs (list (nth (setq n (1+ n)) 3dcoords))); Y [into same list as X]
      Zs (append Zs (list (nth (setq n (1+ n)) 3dcoords))); Z [separate list for Elevation]
    ); setq
  ); repeat
  (command "_.pline" (getvar 'viewctr) "@1,0" ""); temporary quickie basis object
  (vlax-put (setq lwp (vlax-ename->vla-object (entlast))) 'Coordinates XYs)
  (vlax-put lwp 'Elevation (/ (apply '+ Zs) (length Zs))); average elevation
  (vla-put-Closed lwp (vla-get-Closed 3dpobj))
  (princ)
); defun

Lightly tested, and it could use all the usual other enhancements [though the typical Osnap control is not needed even though there's a (command) function involved], as well as some possible more-particular things like making sure PLINEWID is set to 0 [or setting that within the Pline command] if desired.

[I started out trying (cons) rather than (append) to build the separated-coordinates lists, which would use less code, but with these kinds of values that results in compounded dotted-pair  lists.]

[ArchD]

Ranjit, this is perfect, absolutely fantastic.

I'm not sure what I'd do without this forum because I struggle with coding so my appreciation for all of you guys giving their ideas and versions of code is awesome. Thanks everyone for the quick help. This is going to help me out tremendously.

[john.uhden]

If plist is the list of all 3D points, then I think the weighted average would be calculated as follows:

(defun weighted_av (plist / i p1 p2 Zav seglen tlen weight @2d)
  (defun @2d (p)(list (car p)(cadr p)))
  (setq i  0 weight 0 tlen 0)
  (repeat (1- (length plist))
    (setq p1 (nth i plist)
             p2 (nth ((setq i (1+ i)) plist)
             Zav (* 0.5 (+ (last p1)(last p2)))
             seglen (distance (@2d p1)(@2d p2))
             tlen (+ tlen seglen)
             weight (+ weight (* seglen Zav))
    )
  )
  (/ weight tlen)
)

;; BTW, I find it easier to get the plist from the polyline object's coordinates:

(setq coords (vlax-get 3dpolyobj 'Coordinates)) ;; which is a flat list.

;; then use this function to group the flat list into a list of (x y z) lists.:

(defun @group (old n / item new)
  (while old
    (while (< (length item) n)
      (setq item (cons (car old) item) old (cdr old))
    )
    (setq new (cons (reverse item) new) item nil)
  )
  (reverse new)
)

(setq plist (@group coords 3))

[john.uhden]

Oops.  Get rid of the red parenthesis...

(defun weighted_av (plist / i p1 p2 Zav seglen tlen weight @2d)
  (defun @2d (p)(list (car p)(cadr p)))
  (setq i 0 weight 0 tlen 0)
  (repeat (1- (length plist))
    (setq p1 (nth i plist)
             p2 (nth ((setq i (1+ i)) plist)
;; here--------------^
             Zav (* 0.5 (+ (last p1)(last p2)))
             seglen (distance (@2d p1)(@2d p2))
             tlen (+ tlen seglen)
             weight (+ weight (* seglen Zav))
    )
  )
  (/ weight tlen)
)

[Ranjit_Singh]

@john.uhden, I think, and I maybe wrong, this will return the same weighted average for a 3d polyline if it were open or closed? Is that the intent or is this code just for open 3d polylines. In any case it's a good utility function for my library 🙂

[john.uhden]

Your observation is very sage.  It will work for both open and close polylines, but if closed the plist must repeat the starting vertex at the end of the list, as in (p1 p2 p3 p4 p1).

(setq plist (append plist (list (car plist))))

or

(setq plist (reverse (cons (car plist)(reverse plist))))

but for this use of plist, it doesn't matter whether it's reversed or not, so

(setq plist (cons (car plist)(reverse plist)))  ;; will do.

and consing is much faster then appending.

[john.uhden]

My apologies, Ranjit.  I didn't notice that you were the author of that response.  I am honored to think of your adding the code to your library.  I would bet that you are the "best-selling" author in that library.  Wait, I get it.  You'll say just about anything for a paint brush, but I don't have your address.  Okay, how about the name and address of your favorite paint store or hardware?  Or just their phone number?

[Ranjit_Singh]

I am bad at creating utility functions. Well maybe not bad, but I just don't think about future. Most of my code is just severely nested functions (for instance post 7, cons 38 portion) which could be easily made into a utility function. I just lack the patience to do that. On the other hand I see that you are very good at creating utility functions. So I wasn't joking when I said I am adding that to my library.

My lack of patience was also hurting my paint brushes. Fortunately, I have my father in law helping me out. He has a lot  more patience cleaning up those brushes 🙂

[john.uhden]

I have just one conclusion...

If you give up on the painting, you don't need to hurt any brushes.  Of course, neither will you have a bed in which to sleep.  😕