Convert a 2D polyline to 3D from attribiut block

April 30, 2014

Hi ,I am searching for a lisp to do two things

a) select all blocks Attribiut then select the 2D polyline --> convert polyline to 3D with the elenetions of the attribiut

b) select 3D polyline --> and give elev to Attribiuts

And work for open and close polylines.

Look the attach drawing.

Drawing1.dwg

April 30, 2014

is this possible to be done

April 30, 2014

So if I understand you correctly you would like, for example, the text in your drawing that reads 115.32 to have a Z that is equal to the text caption rather than a Z of 0.00 as it currently exists. Then you would like the 2D polyline converted to a 3D polyline that has vertices that match each of those elevations. Yes?

Since your "Point" block already contains a point why not just find/create a custom lisp routine that will give each the correct elevation based on the text then connect up all the points using a 3D polyline?

April 30, 2014

Hi ReMark i search for this but i didn't find samething. Do you have any link ?

Thanks

April 30, 2014

I may have. This is how it is described...

Disclaimer: One must register to be able to download any of the free lisp routines. I have not done so which means I don't know if any of the routines that are listed as available actually work as stated or not.

April 30, 2014

I have seen this lisp but i dont't want to register to that site and i think that this lisp is not working with attribiut blocks?

April 30, 2014

I cannot confirm or deny that since I have never tested the lisp routine.

Sorry I was unable to help you.

April 30, 2014

Thank you for your time ReMark

April 30, 2014

Here is a partial answer.

The following will move the insertion point of your point block

at the elevation given by the ELEV attribute.

(defun c:movpt (/ blk en enb enl i ipt ss )
 (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 "Point"))))
 (repeat (setq i (sslength ss))     
    (setq blk (ssname ss (setq i (1- i)))  
          enb (entget blk)
   ipt (assoc 10 enb)
    en (entnext blk)
   enl (entget en)
   
    )
    (while (= (cdr (assoc 0 enl)) "ATTRIB")
       (if (= (cdr (assoc 2 enl)) "ELEV")
          (entmod (subst (cons 10 (list (car ipt) (cadr ipt) (atof (cdr (assoc 1 enl))))) (assoc 10 enb) enb))
)	 
       (setq en (entnext en) enl (entget en))                                                 
    )
 )   
)

April 30, 2014

Hi ymg3 ,

a) i want to select a 3d polyline and in attribiute -->properties-->elev write the elevetion

b)to select all attribiute points (connected with 2d polyline) and then select the polyline and convert the 2d poly line to 3d with the elevetio text of attribiuts

April 30, 2014

Pedro,

I told you it was a partial solution.

Now you may build a list of coordinates with the new elevation

and entmake your 3dpoly.

Here a routine by Alan J Thompson that will entmake your 3dpoly.

You supply a point list :

;; entmake a 3dpoly      by AlanJT                                            ;
(defun _pline (lst)
   (if (and (> (length lst) 1)
            (entmakex '((0 . "POLYLINE") (10 0. 0. 0.) (70 . ))
            (foreach x lst (entmakex (list '(0 . "VERTEX") (cons 10 x) '(70 . 32))))
       )
     (cdr (assoc 330 (entget (entmakex '((0 . "SEQEND"))))))
   )
 )

ymg

April 30, 2014

thank you ymg3

April 30, 2014

Try this for making the 3dpoly.

(defun c:chgpoly ( )
 (setq en1 (car (entsel"\nSelect Polyline: "))
 pl (listpol en1)
 ss (ssget "_F" pl '((0 . "INSERT")))
       lst nil	
 )
 (repeat (setq i (sslength ss))     
    (setq blk (ssname ss (setq i (1- i)))  
          enb (entget blk)
   ipt (cdr (assoc 10 enb))
    en (entnext blk)
   enl (entget en)
    )
    (while (= (cdr (assoc 0 enl)) "ATTRIB")
       (if (= (cdr (assoc 2 enl)) "ELEV")
   (progn
      (setq  p (list (car ipt) (cadr ipt) (atof (cdr (assoc 1 enl))))
           lst (cons p lst)
      )
   )  
)	 
       (setq en (entnext en) enl (entget en))                                                 
    )
 )
 (if (vlax-curve-IsClosed en1) (setq lst (cons (last lst) lst)))
 (_pline lst)
 (entdel en1)
)
   
         
  

;; entmake a 3dpoly      by Alan J Thompson                                   ;
(defun _pline (lst)
   (if (and (> (length lst) 1)
            (entmakex '((0 . "POLYLINE") (10 0. 0. 0.) (70 . ))
            (foreach x lst (entmakex (list '(0 . "VERTEX") (cons 10 x) '(70 . 32))))
       )
     (cdr (assoc 330 (entget (entmakex '((0 . "SEQEND"))))))
   )
 )

;; List vertices of a polyline  Original code by Gile Chanteau                ;
(defun listpol (en / i p l)  
 (setq	i (if (vlax-curve-IsClosed en)
 	     (vlax-curve-getEndParam en)
     (+ (vlax-curve-getEndParam en) 1)
  )
 )	
 (while (setq p (vlax-curve-getPointAtParam en (setq i (1- i))))
     (setq l (cons p l))
 )
)

Edited April 30, 2014 by ymg3

May 1, 2014

thank you ymg3 works fine ...

May 1, 2014

a) i want to select a 3d polyline and in attribiute -->properties-->elev write the elevetion

b)to select all attribiute points (connected with 2d polyline) and then select the polyline and convert the 2d poly line to 3d with the elevetio text of attribiuts

Hi prodromosm,

see the following codes just as "quick and dirty demos, not finalized codes" and as a different approach to what you're trying to achieve.

This "demos" should work as expected in WCS...

With the demo1, you only need to select the LWPOLYLINE (2D) that is connecting all the "Point" blocks to generate a 3DPolyline with the with the "ELEV" information.

(defun c:demo1 (/ attlst e lst obj par poly pt s s1 z)
 (if (setq s (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
   (progn
     (vl-cmdf "_.DRAWORDER"  (ssname s 0) "" "_B"
       "_.zoom" "_O" (ssname s 0) ""
       "_.-layer" "_M" "3DPoly_Test" "_C" "3" "3DPoly_Test" "" ""
     );; vl-cmdf
     (setq poly (vlax-ename->vla-object (ssname s 0))
    e	 (fix (vlax-curve-getEndParam poly))
    par	 0
    lst	 nil
     );; setq
     (while (/= par (1+ e))
(setq pt (vlax-curve-getPointAtParam poly par))
(if (setq s1 (ssget pt '((0 . "INSERT") (2 . "Point") (66 . 1))))
  (progn
    (setq obj	 (vlax-ename->vla-object (ssname s1 0))
	  attlst (vlax-invoke obj 'GetAttributes)
    );; setq
    (foreach att attlst
      (if (= (vla-get-TagString att) "ELEV")
	(setq z	  (atof (vla-get-TextString att))
	      pt  (list (car pt) (cadr pt) z)
	      lst (cons pt lst)
	);; setq
      );; if
    );; foreach
  );; progn
);; if
(setq par (1+ par))
     );; while
     (if lst
(progn
  (setq lst (reverse lst))
  (entmake (list '(0 . "POLYLINE")
		 (if (vlax-curve-IsClosed poly)
		   '(70 . 9)
		   '(70 . 
		 );; if
	   );; list
  );; entmake
  (foreach x lst
    (entmake (list '(0 . "VERTEX")
		   '(70 . 32)
		   (cons 10 x)
	     );; list
    );; entmake
  );; foreach
  (entmake '((0 . "SEQEND")))
);; progn
     );; if
     (vl-cmdf "_.zoom" "_P")
   );; progn
 );; if
 (princ)
);; demo1

With the demo2, you only need to select the 3DPolyline that is connecting all the "Point" blocks to to populate the "ELEV" "TAG" with the elevation value.

(defun c:demo2 (/ attlst e obj par poly pt s s1 )
 (if (setq s (ssget "_+.:E:S" '((0 . "POLYLINE") (-4 . "&") (70 . )))
   (progn
     (vl-cmdf "_.DRAWORDER" (ssname s 0) "" "_B"
       "_.zoom" "_O" (ssname s 0) ""
     );; vl-cmdf
     (setq poly (vlax-ename->vla-object (ssname s 0))
    e	 (fix (vlax-curve-getEndParam poly))
    par	 0
     );; setq
     (while (/= par (1+ e))
(setq pt (vlax-curve-getPointAtParam poly par))
(if (setq s1 (ssget pt '((0 . "INSERT") (2 . "Point") (66 . 1))))
  (progn
    (setq obj	 (vlax-ename->vla-object (ssname s1 0))
	  attlst (vlax-invoke obj 'GetAttributes)
    );; setq
    (foreach att attlst
      (if (= (vla-get-TagString att) "ELEV")
	(vla-put-TextString att (rtos (caddr pt) 2 2))
      );; if
    );; foreach
  );; progn
);; if
(setq par (1+ par))
     );; while
     (vl-cmdf "_.zoom" "_P")
   );; progn
 );; if
 (princ)
);; demo2

Hoping that helps...

Henrique

May 1, 2014

Thank you hmsilva nice job. I have one more problem

I am searching for a lisp to conrvert a 3d polyline to polyline.All lisp i found until now conver a 3d polyline to 2d polyline but not to polyline. What i mea when i select the polyline in properties palet write polyline not 2d polyline.

Can you help?

This is the lisp i am talking ,but when i select the polyline say 2d polyline not just polyline .

;;CADALYST 09/03 AutoLISP Solutions
;;; PLINE-3D-2D.LSP - a program to convert
;;; 3D polylines to 2D
;;; Program by Tony Hotchkiss

(defun pline-3d-2d ()
 (vl-load-com)
 (setq	*thisdrawing* (vla-get-activedocument
		(vlax-get-acad-object)
	      ) ;_ end of vla-get-activedocument
*modelspace*  (vla-get-ModelSpace *thisdrawing*)
 ) ;_ end of setq
 (setq	3d-pl-list
 (get-3D-pline)
 ) ;_ end of setq
 (if 3d-pl-list
   (progn
     (setq vert-array-list (make-list 3d-pl-list))
     (setq n (- 1))
     (repeat (length vert-array-list)
(setq vert-array (nth (setq n (1+ n)) vert-array-list))
(setq lyr (vlax-get-property (nth n 3d-pl-list) 'Layer))
(setq obj (vla-AddPolyline *modelspace* vert-array))
(vlax-put-property obj 'Layer lyr)
     ) ;_ end of repeat
     (foreach obj 3d-pl-list (vla-delete obj))
   ) ;_ end of progn
 ) ;_ end of if
) ;_ end of pline-3d-2d

(defun get-3D-pline ()
 (setq	pl3dobj-list nil
obj	     nil
3d	     "AcDb3dPolyline"
 ) ;_ end of setq
 (setq selsets (vla-get-selectionsets *thisdrawing*))
 (setq ss1 (vlax-make-variant "ss1"))
 (if (= (vla-get-count selsets) 0)
   (setq ssobj (vla-add selsets ss1))
 ) ;_ end of if
 (vla-clear ssobj)
 (setq Filterdata (vlax-make-variant "POLYLINE"))
 (setq no-ent 1)
 (while no-ent
   (vla-Selectonscreen ssobj)
   (if	(> (vla-get-count ssobj) 0)
     (progn
(setq no-ent nil)
(setq i (- 1))
(repeat	(vla-get-count ssobj)
  (setq
    obj	(vla-item ssobj
		  (vlax-make-variant (setq i (1+ i)))
	) ;_ end of vla-item
  ) ;_ end of setq
  (cond
    ((= (vlax-get-property obj "ObjectName") 3d)
     (setq pl3dobj-list
	    (append pl3dobj-list (list obj))
     ) ;_ end of setq
    )
  ) ;_ end-of cond
) ;_ end of repeat
     ) ;_ end of progn
     (prompt "\nNo entities selected, try again.")
   ) ;_ end of if
   (if	(and (= nil no-ent) (= nil pl3dobj-list))
     (progn
(setq no-ent 1)
(prompt "\nNo 3D-polylines selected.")
(quit)
     ) ;_ end of progn
   ) ;_ end of if
 ) ;_ end of while  
 (vla-delete (vla-item selsets 0))
 pl3dobj-list
) ;_ end of get-3D-pline


(defun get-3D-pline-old ()
 (setq no-ent 1)
 (setq	filter '((-4 . "<AND")
	 (0 . "POLYLINE")
	 (70 . 
	 (-4 . "AND>")
	)
 ) ;_ end of setq
 (while no-ent
   (setq ss	       (ssget filter)
  k	       (- 1)
  pl3dobj-list nil
  obj	       nil
  3d	       "AcDb3dPolyline"
   ) ;_ end-of setq
   (if	ss
     (progn
(setq no-ent nil)
(repeat	(sslength ss)
  (setq	ent (ssname ss (setq k (1+ k)))
	obj (vlax-ename->vla-object ent)
  ) ;_ end-of setq
  (cond
    ((= (vlax-get-property obj "ObjectName") 3d)
     (setq pl3dobj-list
	    (append pl3dobj-list (list obj))
     ) ;_ end of setq
    )
  ) ;_ end-of cond
) ;_ end-of repeat
     ) ;_ end-of progn
     (prompt "\nNo 3D-polylines selected, try again.")
   ) ;_ end-of if
 ) ;_ end-of while
 pl3dobj-list
) ;_ end of get-3D-pline-old

(defun make-list (p-list)
 (setq	i (- 1)
vlist nil
calist nil
 ) ;_ end of setq
 (repeat (length p-list)
   (setq obj	 (nth (setq i (1+ i)) p-list)
  coords (vlax-get-property obj "coordinates")
  ca	 (vlax-variant-value coords)
   ) ;_ end-of setq
   (setq calist (append calist (list ca)))
 ) ;_ end-of repeat
) ;_ end-of make-list

(defun c:pl32 ()
 (pline-3d-2d)
 (princ)
) ;_ end of pl32

(prompt "Enter PL32 to start: ")

Edited May 1, 2014 by prodromosm

May 1, 2014

Pedro,

I don't understand why you would want to do this but, the listpol routine

will give you the vertices of any kind of polylines or lwpoly. Just apply the returns list

to AlanJT's routine _pline.

ymg

May 1, 2014

Thank you hmsilva nice job. I have one more problem

I am searching for a lisp to corver a 3d polyline to polyline.All lisp i found until now conver a 3d polyline to 2d polyline but not to polyline. What i mea when i select the polyline in properties palet write polyline not 2d polyline.

Can you help?

You're welcome, prodromosm!

We can't transform 2dpolylynes, or 3dpolylines in lwpolylines, what can be made is select an 2d/3dpolyline colect the vértices points and entmake a new lwpolyline with the previous data and entdel the original polyline...

As a demo, will fail if the polyline have arcs, and will not delete the original polyline, is only a startpoint...

(defun c:demo3 (/ E ELV LST PAR POLY PT PT0 LST S X ZDIR)
 (vl-load-com)
 (if (setq s (ssget "_+.:E:S" '((0 . "POLYLINE") )))
   (progn
     (setq poly (vlax-ename->vla-object (ssname s 0))
    e	 (fix (vlax-curve-getEndParam poly))
    par	 0
    lst	 nil
     );; setq
     (while (/= par (1+ e))
(setq pt  (vlax-curve-getPointAtParam poly par)
      pt0 (list (car pt) (cadr pt) 0.0)
      lst (cons pt0 lst)
);; setq
(setq par (1+ par))
     );; while
     (if lst
(progn
  (setq	lst  (reverse lst)
	zdir (trans '(0 0 1) 1 0 T)
	elv  (caddr (trans (car lst) 1 zdir))
  );; setq
  (entmake
    (append
      (list (cons 0 "LWPOLYLINE")
	    (cons 100 "AcDbEntity")
	   ;(cons 8 "YourLayer")
	   ;(cons 62 "YourColor")
	    (cons 100 "AcDbPolyline")
	    (cons 90 (length lst))
	    (if	(vlax-curve-IsClosed poly)
	      '(70 . 1)
	      '(70 . 0)
	    );; if
	    (cons 38 elv)
	   ;(cons 43 "YourWidth)
	    (cons 210 zdir)
      );; list
      (mapcar '(lambda (x) (cons 10 (trans x 1 zdir))) lst)
    );; append
  );; entmake
);; progn
     );; if
   );; progn
 );; if
 (princ)
);; demo3

HTH

Henrique

May 1, 2014

ymg3 i can not understand your answer. Ι post pline-3d-2d lisp and i can not understast why covert a 3d polyline to 2d polyline and not to a simple polyline. Is it possible to change ?

Thanks

May 1, 2014

Thank you hmsilva

Sign In

Convert a 2D polyline to 3D from attribiut block

Recommended Posts

Guest

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

Guest

ReMark

Guest

ReMark

Guest

ReMark

Guest

ymg3

Guest

ymg3

Guest

ymg3

Guest

hmsilva

Guest

ymg3

hmsilva

Guest

Guest

Join the conversation

Tutorials

Forums

Activity