Converting 2D Polyline to 3D Poly line with elevation.

[manixlr8.mk]

Hello,

Can anyone suggest me lisp to convert a Polyline from 2D to 3D by adding the elevation value (Which is in text near to the vertice but not exactly coincided with the existing vertice). And if possible adding vertices in the converted 3D line at given interval.

[Frjuniornogueira]

Hello @manixlr8.mk
Have you tried on properties ?
could you attach a .dwg detailing your problem?

[manixlr8.mk]

Thanks for the reply,

Here I'm attaching the sample drawing.

I've tried in properties it works but the amount of vertices is bothering me to use that method. The alignment there in red colour is in 2d Pline and that the one which I need to convert to 3D P line by taking the elevation from the text nearby it.

And new vertices need to be added at given uniform distances.

[Frjuniornogueira]

@manixlr8.mk This was not very simple, but try this:

(defun ssget->vla-list (ss / i ename allobj)
 (if ss
  (progn
       (setq i -1)
       (while (setq  ename (ssname ss (setq i (1+ i))))
         (setq allobj (cons (vlax-ename->vla-object ename) allobj))
       )
       allobj))
)
(defun c:AutoElev ( / linework number ent elist elevat circle newradius numlines
           ActDoc bb pt1 pt2 insxpt midpoint count maxrad radius)
(vl-load-com)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-EndUndoMark ActDoc)
(vla-StartUndoMark ActDoc)
(setq count 0)
(vlax-for i (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object)))
 (if (member (vla-get-objectname i) '("AcDbMText" "AcDbText"))
  (progn
   (vl-catch-all-apply 'vla-getboundingbox
    (list i 'minpoint 'maxpoint))
   (setq pt1 (vlax-safearray->list minpoint)
         pt2 (vlax-safearray->list maxpoint)
         midpoint (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pt1 pt2)
         inc (/ (* pi 2) 10)
         radius (/ (vla-get-height i) 4)
         newradius radius
         maxrad (* 25 radius)
         elevat nil)
   (while (and (<= newradius maxrad)(null elevat))
    (setq plist nil n 0)
    (while (<= n 10)
           (setq n (1+ n) plist (append plist (list (polar midpoint (* inc n) newradius))))
    )
    (setq newradius (+ newradius (/ radius 2)))
    (and
     (setq linework
      (ssget->vla-list
       (ssget "_CP" plist (list (cons 0 "*POLYLINE")))))
     (setq number (vla-get-textstring i) elevat (atof number))
     (not (vla-put-elevation (nth 0 linework) elevat))
     (setq count (1+ count))
     (grtext -2 (strcat (itoa count) " Flat Segments Elevated."))
    );and
   );while
  );progn
 );if
);vlax-for
(vla-EndUndoMark ActDoc)
(princ (strcat "\nProcess Complete..." (itoa count) " Segments Elevated."))
(princ)
)
(prompt ">> AutoElev <<")

[devitg]

erased

[manixlr8.mk]

Thanks, sir

You made my day with that. And sure it's not a regular thing to do. But one thing that the elevation (Z value) added is same for all the vertices when I used list command it shows all the vertices had the same elevation value. can you fix it, please?

[Frjuniornogueira · Accepted solution]

@manixlr8.mk
Try this, something simpler that works very well.
(Note: Install AutoCAD Civil 3D this task is easily done there)

(defun c:AutoElev02 (/ enx idx lst pll ptl sel)
  (princ "\nSelect points 2d polylines: ")
  (if (setq sel (ssget '((0 . "LWPOLYLINE,TEXT"))))
    (progn
      (repeat (setq idx (sslength sel))
	(setq enx (entget (ssname sel (setq idx (1- idx)))))
	(if (= "TEXT" (cdr (assoc 0 enx)))
	  (setq ptl (cons (cdr (assoc 10 enx)) ptl))
	  (setq	pll
		 (cons
		   (mapcar
		     'cdr
		     (vl-remove-if-not '(lambda (x) (= 10 (car x))) enx)
		   )
		   pll
		 )
	  )
	)
      )
      (foreach grp pll
	(foreach vtx grp
	  (if (setq
		vtx (car (vl-member-if
			   '(lambda (a)
			      (equal vtx (list (car a) (cadr a)) 1e-4)
			    )
			   ptl
			 )
		    )
	      )
	    (setq lst (cons vtx lst))
	  )
	)
	(if (cdr lst)
	  (progn
	    (entmake '((0 . "POLYLINE") (70 . 8)))
	    (foreach vtx lst
	      (entmake
		(list
		  '(00 . "VERTEX")
		  '(70 . 32)
		  (cons 10 vtx)
		)
	      )
	    )
	    (entmake '((0 . "SEQEND")))
	  )
	)
	(setq lst nil)
      )
    )
  )
  (princ)
)
(prompt ">> AutoElev02 <<")