topic Re: Lisp routine to convert 2d Polyline to polyline in Visual LISP, AutoLISP and General Customization Forum

Lisp routine to convert 2d Polyline to polyline

C.Utzinger — Fri, 02 Jun 2017 07:03:28 GMT

I just need to convert 2D Polylines to Polylines in a lisp routine.

PEDIT would work, but not in a lisp routine.

Thanks...

Re: Lisp routine to convert 2d Polyline to polyline

vladimir_michl — Fri, 02 Jun 2017 07:53:00 GMT

You mean the CONVERTPOLY command? Or 3D Polylines?

Vladimir Michl, www.cadstudio.cz www.cadforum.cz

Re: Lisp routine to convert 2d Polyline to polyline

_gile — Fri, 02 Jun 2017 07:58:49 GMT

Hi,

You can try this old one:

;; OldStyle2LwPolyline (2008/03/31)
;; Replace a 2d polyline with a light weight polyline
;;
;; Argument : 2d polyline (ename)
;; Return : light weight polyline (ename)

(defun OldStyle2LwPolyline (pl / plst xdata vtx vlst elst)
  (setq	plst  (entget pl '("*"))
	xdata (assoc -3 plst)
	vtx   (entnext pl)
  )
  (while (= (cdr (assoc 0 (setq vlst (entget vtx)))) "VERTEX")
    (if	(zerop (logand (cdr (assoc 70 vlst)) 16))
      (setq elst (cons (vl-remove-if-not
			 (function
			   (lambda (x)
			     (member (car x) '(10 40 41 42))
			   )
			 )
			 vlst
		       )
		       elst
		 )
      )
    )
    (setq vtx (entnext vtx))
  )
  (if (setq new
	     (entmakex
	       (append
		 (list
		   '(0 . "LWPOLYLINE")
		   '(100 . "AcDbEntity")
		   (assoc 410 plst)
		   (assoc 8 plst)
		   (cond
		     ((assoc 39 plst))
		     (T '(39 . 0))
		   )
		   '(100 . "AcDbPolyline")
		   (cons 90 (length elst))
		   (cons 70 (logand 129 (cdr (assoc 70 plst))))
		   (cons 38 (last (caar elst)))
		   (assoc 210 plst)
		 )
		 (apply 'append (reverse elst))
		 (if xdata
		   (list xdata)
		 )
	       )
	     )
      )
    (entdel pl)
  )
  new
)

Re: Lisp routine to convert 2d Polyline to polyline

C.Utzinger — Fri, 02 Jun 2017 08:04:20 GMT

This command CONVERTPOLY would work also, but not in a Lisp Routine...

Re: Lisp routine to convert 2d Polyline to polyline

C.Utzinger — Fri, 02 Jun 2017 08:13:40 GMT

I just not could made it work.

But such a big code? Is there not an easier way, like an easy command, witch works in Lisp?

Kind regards

Re: Lisp routine to convert 2d Polyline to polyline

_gile — Fri, 02 Jun 2017 08:29:03 GMT

c.utzinger a écrit :

I just not could made it work.

But such a big code? Is there not an easier way, like an easy command, witch works in Lisp?

Kind regards

OldStyle2LwPolyline is a sub routine or user defined LISP function which can be used as a built-in function:

(defun c:2DTOLW (/ s i)
  (if (setq s (ssget '((0 . "POLYLINE") (-4 . "<not") (-4 . "&") (70 . 120) (-4 . "not>"))))
    (repeat (setq i (sslength s))
      (OldStyle2LwPolyline (ssname s (setq i (1- i))))
    )
  )
  (princ)
)

Re: Lisp routine to convert 2d Polyline to polyline

ВeekeeCZ — Fri, 02 Jun 2017 08:32:24 GMT

@c.utzinger wrote:

This command CONVERTPOLY would work also, but not in a Lisp Routine...

PEDIT would work, but not in a lisp routine.

What do you mean, why not?

Re: Lisp routine to convert 2d Polyline to polyline

C.Utzinger — Fri, 02 Jun 2017 08:33:49 GMT

OK, i just find out there is another Problem in the code, i just have to find out why...

If i don´t, i will write again 🙂

Re: Lisp routine to convert 2d Polyline to polyline

_gile — Fri, 02 Jun 2017 08:42:19 GMT

The CONVERT and CONVERTPOLY commands won't work with splined or fitted 2d polylines, the code I posted does.

This may be why it's "such a big code" (only 50 lines).

Re: Lisp routine to convert 2d Polyline to polyline

C.Utzinger — Fri, 02 Jun 2017 08:46:11 GMT

Thank you

I found the Problem. Convert works perfect in my case.

Kind regards

Re: Lisp routine to convert 2d Polyline to polyline

john.uhden — Sat, 03 Jun 2017 23:39:10 GMT

Yay, UTZ! I think I found that you can accept your own solution. :]

Re: Lisp routine to convert 2d Polyline to polyline

C.Utzinger — Sun, 04 Jun 2017 18:31:12 GMT

LOL

Thank you...

Perhaps in another place and another time 🙂

Regards

Re: Lisp routine to convert 2d Polyline to polyline

john.uhden — Sun, 04 Jun 2017 19:02:12 GMT

I just stumbled on this, which you might find to be fun...

  ;;------------------------------------------------------------
  ;; Function created (06-10-02) to convert a complex 2dPolyline
  ;; (Type 1 = Fit curved, Type 2,3 = Splined)
  ;; into a Type 0 = Simple
  ;; while retaining all geometry.
  ;; Revised (07-06-02) to handle 3D polylines as well.
  ;;
  (defun @cv_simplify (e0 / Object e ent Visible Param Done P Sw Ew Bulge
                            Vlist Blist Wlist Width Werror 2D)
    (cond
      ((= (type e0) 'VLA-Object)
        (setq Object e0 e0 (vlax-vla-object->ename Object))
      )
      ((= (type e0) 'ENAME)
        (setq Object (vlax-ename->vla-object e0))
      )
    )
    (setq Visible (vla-get-Visible Object)
          Width   (vl-catch-all-apply 'vla-get-ConstantWidth (list Object))
          Werror  (vl-catch-all-error-p Width)
          2D      (= (vla-get-ObjectName Object) "AcDb2dPolyline")
          e       e0
    )
    (while (not Done)
      (and
        (setq e (entnext e))
        (setq ent (entget e))
        (or (= (cdr (assoc 0 ent)) "VERTEX")
            (not (setq Done 1))
        )
        (/= (logand 16 (cdr (assoc 70 ent))) 16) ; spline control point
        (setq P (cdr (assoc 10 ent)))
        (setq Vlist (cons P Vlist))
        2D
        (or
          (not Werror)
          (setq Sw    (cdr (assoc 40 ent))
                Ew    (cdr (assoc 41 ent))
                Wlist (cons (cons Sw Ew) Wlist)
          )
        )
        (setq Bulge (cdr (assoc 42 ent)))
        (setq Blist (cons Bulge Blist))
      )
    )
    (setq Blist (reverse Blist)
          Wlist (reverse Wlist)
    )
    (if (= Visible :vlax-true)
      (vla-put-visible Object :vlax-false)
    )
    (vla-put-type Object 0)
    (vlax-release-object Object)
    (setq Object (vlax-ename->vla-object e0))
    (vlax-put Object "Coordinates" (apply 'append (reverse Vlist)))
    (setq Param 0)
    (repeat (length Blist)
      (vla-setbulge Object Param (nth Param Blist))
      (and
        Werror
        (setq Width (nth Param Wlist))
        (vla-setwidth Object Param (car Width)(cdr Width))
      )
      (setq Param (1+ Param))
    )
    (if (not Werror)
      (vla-put-ConstantWidth Object Width)
    )
    (vla-put-visible Object Visible)
  )