3D pline to 2D pline lisp

Gustavo Franca

Hi there. I'm having a hard time trying to make this lisp run. It's a 3D-2D pline converter and it seems to have some problem at the "vla-clear" expression. It works just fine with AutoCAD. Can somebody give me a hand?



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

Roy Klein Gebbinck

There are quite a few issues with the code...
But the problem you mention is caused by the (get-3D-pline) function. This function can only work if (vla-get-count selsets) returns 0. But in BricsCAD there are two selection sets by default. This may be different in AutoCAD.

The easiest fix is to use the (get-3D-pline-old) function instead.
In the function (pline-3d-2d) change:
[code](setq 3d-pl-list
  (get-3D-pline)
) ;_ end of setq[/code]
To
[code](setq 3d-pl-list
  (get-3D-pline-old)
) ;_ end of setq[/code]

Jason Bourhill

As an alternative, you could try the FLATTEN command. This will convert 3D Polylines to 2D Polylines as part of the flattening process.

[code]; Convert 3D Polylines to 2D using the FLATTEN command.
; uses defaul FLATTEN options

(defun C:Poly3D2D ( / sset)
    (princ "\nSelect 3D Polylines to Flatten to 2D")
    (setq sset (ssget '((0 . "POLYLINE")(100 . "AcDb3dPolyline")))) ; Allow selection of only 3D Polylines
    (if sset
            (command "._FLATTEN" sset "")
            (princ "\nNo 3D Polylines selected")
    )
    (prin1)
)[/code]

Regards,

Jason Bourhill

CAD Concepts

Gustavo Franca

@Jason Bourhill:

As an alternative, you could try the FLATTEN command. This will convert 3D Polylines to 2D Polylines as part of the flattening process.

; Convert 3D Polylines to 2D using the FLATTEN command.; uses defaul FLATTEN options(defun C:Poly3D2D ( / sset)    (princ "\nSelect 3D Polylines to Flatten to 2D")    (setq sset (ssget '((0 . "POLYLINE")(100 . "AcDb3dPolyline")))) ; Allow selection of only 3D Polylines    (if sset            (command "._FLATTEN" sset "")            (princ "\nNo 3D Polylines selected")    )    (prin1))   

Regards,

Jason Bourhill

CAD Concepts

Jason and Roy, thank you for your help! The command flatten works just fine, no need for lisp! I really appreciate, guys, thanks a lot.