Trouble converting 3d to 2d polyline

Automohan · ‎09-16-2018

;;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 . 8)
		 (-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: ")

I am using AutoCAD 2017

Error as shown below, forward to look for your reply soon as possible

"Save Energy"
Did you find this reply helpful? If so please use the Accept as Solution

Kent1Cooper · ‎09-16-2018

I don't know why that's happening, but at the bottom of the Cadalyst page, under the comments, pick Next and see comment #6, which may give you a workable different way to do it.

Kent Cooper, AIA

john.uhden · ‎09-16-2018

You might want to try this offering...

(defun C:M2D ( / *error* Doc vars vals |e0 |e |ent |etyp |flag @2d |p |v |elev |ans |ss
               |ssl |ssl$ |p1 |p2 p# l# |cmd |hl |os |layer |space |felev
               |dimzin |acdb |cut |rel |layer |layers)
   ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
   ;*                                                                           *
   ;*         M2D.LSP    by     John F. Uhden                                   *
   ;*                           2 Village Road                                  *
   ;*                           Sea Girt, NJ  08750                             *
   ;*                                                                           *
   ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

   ; Routine converts a selection of lines and/or polylines into 2D at a user-
   ; specified elevation.

   ; v13.1 (10-18-97) added R14 LWPOLYLINE making.
   ; v15.00 (04-07-00) for R15
   ;        (11-28-00) replaced local functions with globals...
   ;                   @cut_list with @cv_cut_list
   ;        (12-17-00) added multiple picks for Picklayer option
   ; (09-16-18) modernized a little for ACAD forum.

   (gc)
   (prompt "\nM2D v15.00 (c)1994-2000, John F. Uhden, Cadlantic.")
   (prompt "\n    Turns 3D LINES and POLYLINES into 2D.")
   ;;----------------------------------------------------
   ;; Check Version of AutoCAD... Must be 12 or greater:
   ;;
   (if (< (atoi (getvar "ACADVER")) 12)
      (progn
         (prompt "\nRequires AutoCAD Release 12 or higher.")
         (exit)
      )
   )

   (defun *error* (err)
      (mapcar 'setvar vars vals)
      (vla-endundomark Doc)
      (cond
        ((not err))
        ((wcmatch (strcase err) "*CANCEL*,*QUIT*"))
        (1
          (vl-exit-with-error (strcat "\r*ERROR*: " err))
        )
      )
      (princ)
   )
   (setq vars '(cmdecho dimzin highlight osmode))
   (setq vals (mapcar 'getvar vars))
   (setq Doc (vla-get-activedocument (vlax-get-acad-object)))
   (vla-startundomark Doc)
   (mapcar 'setvar vars '(0 1 0 0))
   ;;-------------------------------------------
   ;; Initialize drawing and program variables:
   ;;
   (setq |elev (getvar "elevation")
              |rel (atoi (getvar "acadver"))
   )
   ;;--------------------------------------------------------------
   ;; Function to convert a 3D point to 2D at a selected elevation:
   ;;
   (defun @2d (|p)
      (reverse (cons |elev (cdr (reverse |p))))
   )
   ;;------------------------------------------------
   ;; This is the start of user input and processing.
   ;;
   (initget "First Pick")
   (setq |ans (getreal (strcat "\nElevation, First vertex/Pick/<" (rtos |elev) ">: ")))
   (cond
      ((= |ans "Pick")
         (setvar "osmode" (+ 1024 512)) ; quick,nearest
         (initget 1)
         (setq |elev (getpoint "\nPick a point (osnap=quick,nearest): "))
         (setq |elev (last |elev))
         (setvar "osmode" |os)
      )
      (|ans (setq |elev |ans))
   )
   (initget "All Layers Manually Picklayer")
   (setq |ans (getkword "\nSelection method, All/Layers/Picklayer/<Manually>: "))
   (cond
      ((= |ans "All")
         (prompt "\nGetting ALL LINES and 3D POLYLINES... ")
         (setq |ss
            (ssget "X"
               (list
                 '(-4 . "<OR")
                    '(0 . "LINE")
                    '(-4 . "<AND")
                       '(0 . "POLYLINE")
                       '(-4 . "&")'(70 . 8) ; 3D only
                    '(-4 . "AND>")
                 '(-4 . "OR>")
               )
            )
         )
      )
      ((= |ans "Layers")
         (setq |ans (getstring "\nLayer names <*>: "))
         (if |ans (setq |layer |ans)(setq |layer "*"))
         (prompt "\nGetting all LINES and 3D POLYLINES on selected layer(s)... ")
         (setq |ss
            (ssget "X"
               (list
                  (cons 8 |layer)
                 '(-4 . "<OR")
                    '(0 . "LINE")
                    '(-4 . "<AND")
                       '(0 . "POLYLINE")
                       '(-4 . "&")'(70 . 8) ; 3D only
                    '(-4 . "AND>")
                 '(-4 . "OR>")
               )
            )
         )
      )
      ((= |ans "Picklayer")
         (while (setq |e (car (entsel "\nSelect object on desired layer:")))
            (setq |layer (cdr (assoc 8 (entget |e)))
                  |layers (@cv_add_list |layer |layers)
            )
            (princ (strcat "\nLayers: " (@cv_list2str |layers)))
         )
         (if |layers
            (progn
               (setq |layers (@cv_list2str |layers))
               (prompt (strcat "\nGetting all LINES and 3D POLYLINES on layer(s) " |layers "... "))
               (setq |ss
                  (ssget "X"
                     (list
                        (cons 8 |layers)
                       '(-4 . "<OR")
                          '(0 . "LINE")
                          '(-4 . "<AND")
                             '(0 . "POLYLINE")
                             '(-4 . "&")'(70 . 8) ; 3D only
                          '(-4 . "AND>")
                       '(-4 . "OR>")
                     )
                  )
               )
            )
         )
      )
      (1 (prompt "\nDon't worry about selecting objects that are not LINES or 3D POLYLINES.")
         (prompt "\nThey will be filtered out of selection set.")
         (setq |ss
            (ssget
               (list
                 '(-4 . "<OR")
                    '(0 . "LINE")
                    '(-4 . "<AND")
                       '(0 . "POLYLINE")
                       '(-4 . "&")'(70 . 8) ; 3D only
                    '(-4 . "AND>")
                 '(-4 . "OR>")
               )
            )
         )
      )
   )
   (setvar "highlight" 0)
   (setvar "osmode" 0)
   (if |ss (setq |ss (@cv_check_lock |ss nil)))
   (if |ss
      (setq |ssl (sslength |ss) |ssl$ (itoa |ssl) i 0 p# 0 l# 0)
      (setq |ssl 0 p# nil l# nil)
   )
   (princ (strcat (itoa |ssl) " found.\n"))
   (repeat |ssl
      (setq |e (ssname |ss i)
            |e0 |e
            |ent (entget |e)
            |etyp (cdr (assoc 0 |ent))
            |layer (cdr (assoc 8 |ent))
            i (1+ i)
      )
      (prompt (strcat "\rProcessing # " (itoa i) "/" |ssl$))
      (cond
         ((= |etyp "POLYLINE")
            (setq |flag (cdr (assoc 70 |ent)) |felev nil)
            (cond
               ((= (logand |flag 8) 8)
                  (setq |ent (subst (cons 70 (- |flag 8))(assoc 70 |ent) |ent))
                  ; The following added for R13 (6-29-96)...
                  (if (vl-position (setq |acdb '(100 . "AcDb3dPolyline")) |ent)
                     (setq |ent (subst '(100 . "AcDb2dPolyline") |acdb |ent))
                  )
                  (if (= |rel 12)
                     (entmod |ent)
                     (entmake |ent)
                  )
                  (while (= (cdr (assoc 0 (setq |ent (entget (setq |e (entnext |e)))))) "VERTEX")
                     (setq |flag (cdr (assoc 70 |ent))
                           |flag (- |flag (logand |flag 32))
                           |ent (subst (cons 70 |flag)(assoc 70 |ent) |ent)
                     )

                     ; The following added for R13 (6-29-96)...
                     (if (vl-position (setq |acdb '(100 . "AcDb3dPolylineVertex")) |ent)
                        (setq |ent (subst '(100 . "AcDb2dVertex") |acdb |ent))
                     )
                     (foreach |cut '(71 72 73 74)
                        (setq |ent (vl-remove (assoc |cut |ent) |ent))
                     )

                     (if (not |felev)(setq |felev (last (cdr (assoc 10 |ent)))))
                     (if (= |rel 12)
                        (entmod |ent)
                        (entmake |ent)
                     )
                  )
                  (if (= |rel 12)
                     (entupd |e0)
                     (progn
                        (entdel |e0)
                        (entmake (list '(0 . "SEQEND")(cons 8 |layer)))
                        (setq |e0 (entlast))
                     )
                  )
                  (if (= (type |elev) 'REAL)
                     (command "_.change" |e0 "" "_P" "_E" |elev "")
                     (command "_.change" |e0 "" "_P" "_E" |felev "")
                  )
                  (setq p# (1+ p#))
                  (if (and (> |rel 13)(> (getvar "PLINETYPE") 0))
                     (command "_.CONVERTPOLY" "_L" |e0 "")
                  )
               )
               ((= (logand |flag 16) 16)) ; 3D Polygon Mesh
               ((= (logand |flag 64) 64)) ; 3D Polyface Mesh
            )
         )
         ((= |etyp "LINE")
            (setq |p1 (cdr (assoc 10 |ent)) |p2 (cdr (assoc 11 |ent)))
            (if (/= (last |p1) (last |p2))
               (progn
                  (if (= (type |elev) 'REAL)
                     (setq |p1 (@2d |p1)
                           |p2 (@2d |p2)
                           |ent (subst (cons 10 |p1)(assoc 10 |ent) |ent)
                     )
                     (setq |p2 (list (nth 0 |p2)(nth 1 |p2)(last |p1)))
                  )
                  (setq |ent (subst (cons 11 |p2)(assoc 11 |ent) |ent)
                        l# (1+ l#)
                  )
                  (entmod |ent)
                  (entupd |e)
               )
            )
         )
      )
   )
   (if p# (prompt (strcat "\nModified " (itoa l#) " 3D Lines and " (itoa p#) " 3D Polylines.")))
   (*error* nil)
)

John F. Uhden

ronjonp · ‎09-17-2018

Wouldn't something like this work?

(defun c:foo (/ n o p s)
  ;; RJP » 2018-09-17
  (if (setq s (ssget ":L" '((0 . "POLYLINE"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (setq n 0)
      (setq p (mapcar '(lambda (x)
			 (if (= 0 (rem (setq n (1+ n)) 3))
			   0.0
			   x
			 )
		       )
		      (vlax-get (setq o (vlax-ename->vla-object e)) 'coordinates)
	      )
      )
      (vlax-put o 'coordinates p)
    )
  )
  (princ)
)
(vl-load-com)

Kent1Cooper · ‎09-17-2018

@ronjonp wrote:

Wouldn't something like this work?
(defun c:foo (/ n o p s)....

It does [in quickie trial] put them in a flat plane, but like the FLATTEN command if you don't answer Yes to the remove-hidden-lines question [who would know?], it leaves them as 3D Polyline entities even though only 2D in geometry. That involves some serious limitations [e.g. they can't be Offset, or PEDIT-Joined to, or display or plot in non-continuous linetypes]. The routine in Message 1 [if it worked for the OP--it does in Acad2016 here] turns them into "heavy" 2D Polylines along with flattening them out, and so does my Pline3Dto2D.lsp routine attached to a comment where it comes from in the Cadalyst CAD Tips site. [The comment (go to Next at the bottom for comment #6) describes some drawbacks of the PL32 command; see also comments in the top of the Pline3Dto2D.lsp file.] I have also attached mine here so people don't need to go find it.

Kent Cooper, AIA

ronjonp · ‎09-17-2018

Cool .. that simple snippet was the first thing that came to mind for me. I wonder if the OP has tried Joe Burke's superflatten routine .. it's fairly comprehensive.

Kent1Cooper · ‎09-17-2018

@john.uhden wrote:

You might want to try this offering...
(defun C:M2D ....

That didn't work on 3D Polylines for me [Acad2016 here]. It loads, and the command is recognized, and I can specify the elevation [I tried the various options there], and select objects, and it says it found them, but then nothing happens -- they remain non-flattened with all their original varying Z coordinates. No further messages, error-related or otherwise, to go on. I tried open as well as closed ones, and straight-segmented as well as PEDIT-Spline-curved ones, with the same [non-]results.

Kent Cooper, AIA

john.uhden · ‎09-17-2018

Hmm. Thanks for letting me know. I'll look it over again.

Thanks to someone's kindness I received a box of new play toys. I guess it's time to find the time to install and run them (secretly, lest I am exiled).

John F. Uhden

john.uhden · ‎09-17-2018

Well, no wonder. It was calling functions that are not defined in c:M2D.

Should I add them and repost or just skip it all?

BTW, what happened to the icon to attach a file? Or maybe should I just cut'n'paste from Explorer?

John F. Uhden

john.uhden · ‎09-18-2018

I added the missing functions. I hope this one works.

John F. Uhden

braudpat · ‎09-20-2018

Hello @john.uhden

1) First THANKS for your Routines and Efforts

2) Your M2D routine has a small problem : it doesn't change the Z (Elevation) for Lines with the SAME Z (2D Lines in fact) !? - And it works on Lines with different Z ...

3) For me it's OK on 3DPlines !

Regards, Patrice (The Old French EE Froggy)

Patrice ( Supporting Troops ) - Autodesk Expert Elite
If you are happy with my answer please mark "Accept as Solution" and if very happy please give me a Kudos (Felicitations) - Thanks

Patrice BRAUD

john.uhden · ‎09-20-2018

What? Are you implying I should fix it?
Or should I rename it to M2D± ?

John F. Uhden

braudpat · ‎09-20-2018

Hello John

1) For me your M2D routine is OK and NICE (even with its small bug on LINEs) !

Because I can convert Lines to 3DPLines and then run M2D ...

2) But for other people ... As you wish ...

Thanks, Regards (The Old French EE Froggy)

Patrice ( Supporting Troops ) - Autodesk Expert Elite
If you are happy with my answer please mark "Accept as Solution" and if very happy please give me a Kudos (Felicitations) - Thanks

Patrice BRAUD

john.uhden · ‎09-21-2018

I checked it out, and ,yes, I wrote it that way based on the theory that anything that is of one (singular) elevation is already 2D. Well, that is except for 3D polylines which are by name 3D.

C'mon, Pat. That was ages ago. I think I did pretty well for a young fart.

John F. Uhden

Automohan · ‎09-22-2018

I will reply to this thread soon as possible

"Save Energy"
Did you find this reply helpful? If so please use the Accept as Solution

Community

Trouble converting 3d to 2d polyline

Trouble converting 3d to 2d polyline

Trouble converting 3d to 2d polyline