convert 3d polyline to a 2d polyline and set elevation to lowest Z found in the 3d polyline

convert 3d polyline to a 2d polyline and set elevation to lowest Z found in the 3d polyline

vandenoosterkamp
Collaborator Collaborator
411 Views
4 Replies
Message 1 of 5

convert 3d polyline to a 2d polyline and set elevation to lowest Z found in the 3d polyline

vandenoosterkamp
Collaborator
Collaborator

I found a lisp to convert a 3d polyline to a 2d polyline that grasps the lowest Z value of the 3d polyline and uses that for the elevation of the newly created 2d polyline. It is not working so I wonder if it's any good and an easy fix to get this working.

 

Thanks in advance!

0 Likes
Accepted solutions (2)
412 Views
4 Replies
Replies (4)
Message 2 of 5

Moshe-A
Mentor
Mentor
Accepted solution

@vandenoosterkamp  hi,

 

check this

 

enjoy

Moshe

 

 

(defun c:32low (/ _vertices _lowerZ _chopZ _addDxf10
		   ss ename vertices lowitem poly2D)

 ; return polyline geometric
 (defun _vertices (ename / elist lst)
  (setq ename (entnext ename) elist (entget ename))
  (while (/= (cdr (assoc '0 elist)) "SEQEND")
   (setq lst (cons (cdr (assoc '10 elist)) lst))
   (setq ename (entnext ename) elist (entget ename))
  )
   
  (reverse lst)
 ); _vertices 

 ; Anonymous functions
 (setq _lowerZ (lambda (l) (car (vl-sort l (function (lambda (e0 e1) (< (caddr e0) (caddr e1))))))))
 (setq _chopZ (lambda (l) (mapcar (function (lambda (item) (reverse (cdr (reverse item))))) l)))
 (setq _addDxf10 (lambda (l) (mapcar (function (lambda (item) (cons '10 item))) l)))
  

 ; here start c:32low
 (if (setq ss (ssget '((0 . "polyline") (100 . "AcDb3dPolyline")))) ; select only 3dpolyline
  (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   (if (and
	 (setq vertices (_vertices ename))
	 (setq lowitem  (_lowerZ vertices))
	 (setq vertices (_chopZ vertices))
       )
    (progn       ;; Create a new 2D polyline with the lowest Z value
     (setq poly2D (list '(0 . "LWPOLYLINE") 
                        '(100 . "AcDbEntity") 
                        '(100 . "AcDbPolyline")
			(cons '38 (caddr lowitem))
                        (cons '90 (length vertices)) ; Number of vertices
                  )
     )

     (setq vertices (_addDxf10 vertices))
     (entmake (append poly2D vertices)) ; add 2d polyline at lowerz
     (entdel ename) ; delete 3dpline
    ); progn
   ); if
  ); foreach
 ); if

 (princ)
); c:32low

 

 

0 Likes
Message 3 of 5

Kent1Cooper
Consultant
Consultant
Accepted solution

A different and simpler approach [lightly tested]:

(defun c:3Dto2Dlow (/ ss n ent verts clo m)
  (if (setq ss (ssget '((0 . "POLYLINE") (-4 . "&") (70 . 8)))) ; Select 3D Polyline(s) only
    (repeat (setq n (sslength ss))
      (setq
        ent (ssname ss (setq n (1- n)))
        clo (vlax-curve-isClosed ent)
        verts (+ (fix (vlax-curve-getEndParam ent)) (if clo 0 1))
        m 0
      ); setq
      (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
      (command "_.pline" ".XY" (vlax-curve-getStartPoint ent) (caddr (vlax-safearray->list minpt)))
      (repeat (1- verts)
        (command (vlax-curve-getPointAtParam ent (setq m (1+ m))))
      ); while
      (command (if clo "_close" ""))
      (entdel ent)
    ); repeat
  ); if
  (prin1)
)

It can use the usual enhancements, if it otherwise does what you're after.

Kent Cooper, AIA
Message 4 of 5

vandenoosterkamp
Collaborator
Collaborator

Thanks a lot! Both work like a charm!

0 Likes
Message 5 of 5

komondormrex
Mentor
Mentor

another one, short and silent

(defun c:3d_2d_low (/ 3d_pline_sset index vertices closed pline)
  	(if (setq 3d_pline_sset (ssget '((0 . "polyline") (-4 . "&=") (70 . 8))))
	  (foreach 3d_pline (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex 3d_pline_sset))))  
		(setq index -1 vertices nil)
		(repeat (+ 1 (fix (vlax-curve-getendparam 3d_pline)) (setq closed (vlax-get 3d_pline 'closed))) 
			(setq vertices (append vertices (list (vlax-safearray->list (vlax-variant-value (vla-get-coordinate 3d_pline (setq index (1+ index))))))))
		)
	  	(vla-put-elevation (setq pline (vla-addlightweightpolyline (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
						       (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 1 (* 2 (length vertices))))
									    (apply 'append (mapcar '(lambda (vertex) (reverse (cdr (reverse vertex)))) vertices))
						       )
						)
				   )
		  		   (apply 'min (mapcar 'caddr vertices))
	        )
	  	(vlax-put pline 'closed closed)
	    	(vla-erase 3d_pline)
    	 )
	)
  	(princ)
)
0 Likes