Lisp routine to convert 2d Polyline to polyline

Lisp routine to convert 2d Polyline to polyline

C.Utzinger
Collaborator Collaborator
7,328 Views
12 Replies
Message 1 of 13

Lisp routine to convert 2d Polyline to polyline

C.Utzinger
Collaborator
Collaborator

HI

 

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

 

PEDIT would work, but not in a lisp routine.

 

 

Thanks...

0 Likes
7,329 Views
12 Replies
Replies (12)
Message 2 of 13

vladimir_michl
Advisor
Advisor

You mean the CONVERTPOLY command? Or 3D Polylines?

 

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

Message 3 of 13

_gile
Consultant
Consultant

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
)


Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

Message 4 of 13

C.Utzinger
Collaborator
Collaborator

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

Message 5 of 13

C.Utzinger
Collaborator
Collaborator

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

0 Likes
Message 6 of 13

_gile
Consultant
Consultant

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)
)


Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

Message 7 of 13

ВeekeeCZ
Consultant
Consultant

@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?

0 Likes
Message 8 of 13

C.Utzinger
Collaborator
Collaborator

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 🙂

0 Likes
Message 9 of 13

_gile
Consultant
Consultant

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).



Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

Message 10 of 13

C.Utzinger
Collaborator
Collaborator

Thank you

 

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

 

 

Kind regards

0 Likes
Message 11 of 13

john.uhden
Mentor
Mentor

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

John F. Uhden

0 Likes
Message 12 of 13

C.Utzinger
Collaborator
Collaborator

LOL

 

Thank you...

 

Perhaps in another place and another time 🙂

 

 

Regards

0 Likes
Message 13 of 13

john.uhden
Mentor
Mentor

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)
  )

John F. Uhden