Announcements
Notice: Upload of PDF documents is currently unavailable across the Community due to an ongoing issue.

Lisp routine to convert 2d Polyline to polyline

Lisp routine to convert 2d Polyline to polyline

C.Utzinger
Collaborator Collaborator
9,183 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
9,184 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

Vladimír Michl, CADs.cz - LinkedIn

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