Jump to content

lisp for converting ellipse to polylines?

CADIDAC

By CADIDAC
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

CADIDAC Apprentice

CADIDAC

Posted
Posted

are there any lisps for converting ellipses to polylines. I am tired of not being able to make regions that include ellipses or being able to add them to preexisting polylines.

dbroada Grand Master

dbroada

Posted
Posted

I'm not sure about a LISP but you can draw them as PLINES in the first place....

 

PELLIPSE System Variable
Type: IntegerSaved in: DrawingInitial value: 0
Controls the ellipse type created with ELLIPSE.
0
Creates a true ellipse object.
1
Creates a polyline representation of an ellipse

  • Like 1
CADIDAC Apprentice

CADIDAC

Posted
  • Author
Posted

I was hoping that I wouldn't have to do that, being that I will have to redraw significant amount of my drawing. But if thats the only way. Are there any commands to convert ellipse to plines?

VVA Rising Star

VVA

Posted
Posted

My variant

 

(defun C:E2P (/ adoc el ssnab en item lays lay lock pell ptcen osm)
 (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
 (setq lays (vla-get-layers adoc))
 (vla-startundomark adoc)
 (setq ssnab (ssget '((0 . "ELLIPSE")))) ;_Выбор Region'ов в рисунке
 (setq pell (getvar "PELLIPSE"))
 (setq osm (getvar "OSMODE"))
 (setvar "PELLIPSE" 1)
 (while (and ssnab
      (> (sslength ssnab) 0)
 )
   (setq el (ssname ssnab 0))
   (setq en (vlax-ename->vla-object el))
   (setq lay (vla-item lays (vla-get-layer en)))
   (if (= (vla-get-lock lay) :vlax-true)
     (progn (vla-put-lock lay :vlax-false)
     (setq lock (cons lay lock))
     ))
   (setq item (vla-get-ObjectName en))
   (cond
     ((= item "AcDbEllipse")
      (setq ptcen (vlax-safearray->list
      (vlax-variant-value (vla-get-center en))
    )
      )
      (command "_ellipse"  "_C" ptcen
 (mapcar '+
  ptcen
  (vlax-safearray->list
    (vlax-variant-value (vla-get-MajorAxis en))
  ))
 (mapcar '+
  ptcen
  (vlax-safearray->list
    (vlax-variant-value (vla-get-MinorAxis en))
  )))
      (mapcar
 '(lambda (x y)
    (vlax-put-property (vlax-ename->vla-object (entlast)) x y)
  )
 '(Linetype LineWeight Color Layer)
 (mapcar '(lambda (x)
     (vlax-get-property en x)
   )
  '(Linetype LineWeight Color Layer)
 )
      )
      (vla-Delete en)
     )
     (t nil)
   )
   (ssdel el ssnab)
 )
 (setvar "PELLIPSE" pell)
 (setvar "OSMODE" osm)
 (if lock
   (foreach x lock (vla-put-lock x :vlax-true))
 )
 (vla-endundomark adoc)
 (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
 (princ "\nПреобразование Ellipse завершено")
 (princ "\nTransformation Ellipse is completed")
 )
 (princ)
)
(if (= (getvar "DWGCODEPAGE") "ANSI_1251")
(princ "\nНаберите в ком. строке E2P")
(princ "\nType E2P to run command"))

 

Transformation of splines, circles, lines, ellipses, 2d and 3d polylines in 2d polylines (linear segments)

ConvTo2d -transformation of linear objects in 2D polylines

ConvTo3d -transformation of linear objects in 3D polylines

CADIDAC Apprentice

CADIDAC

Posted
  • Author
Posted

when copying the text and saving in notepad will format, unicode, unicode big endian, or UTF-8, make a difference? I ask because I am saving and successfully loading them but when typing the defun c:e2p value, in the last case e2p, autocad displays an error.

VVA Rising Star

VVA

Posted
Posted

Without Russian Text

(defun C:E2P (/ adoc el ssnab en item lays lay lock pell ptcen osm count)
 (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
 (setq lays (vla-get-layers adoc) count 0)
 (vla-startundomark adoc)
 (princ "\nSelect Ellipse")
 (setq ssnab (ssget '((0 . "ELLIPSE"))))
 (setq pell (getvar "PELLIPSE"))
 (setq osm (getvar "OSMODE"))
 (setvar "OSMODE" 0)
 (setvar "PELLIPSE" 1)
 (while (and ssnab (> (sslength ssnab) 0))
   (setq el (ssname ssnab 0))
   (setq en (vlax-ename->vla-object el))
   (setq lay (vla-item lays (vla-get-layer en)))
   (if (= (vla-get-lock lay) :vlax-true)
     (progn (vla-put-lock lay :vlax-false)
     (setq lock (cons lay lock))))
   (setq item (vla-get-ObjectName en))
   (cond
     ((= item "AcDbEllipse")(setq count (1+ count))
      (setq ptcen (vlax-safearray->list(vlax-variant-value (vla-get-center en))))
      (command "_.ellipse"  "_C" (trans ptcen 0 1)
               (trans (mapcar '+ ptcen (vlax-safearray->list(vlax-variant-value (vla-get-MajorAxis en)))) 0 1)
               (trans (mapcar '+ ptcen (vlax-safearray->list(vlax-variant-value (vla-get-MinorAxis en)))) 0 1))
      (mapcar '(lambda (x y)(vlax-put-property (vlax-ename->vla-object (entlast)) x y))
              '(Linetype LineWeight Color Layer)
              (mapcar '(lambda (x)(vlax-get-property en x))
                      '(Linetype LineWeight Color Layer))
              )
      (vla-Delete en)
     )
     (t nil)
   )
   (ssdel el ssnab)
 )
 (setvar "PELLIPSE" pell)
 (setvar "OSMODE" osm)
 (if lock (foreach x lock (vla-put-lock x :vlax-true)))
 (vla-endundomark adoc)
 (princ (strcat "\nTransformation " (itoa count) " Ellipse is completed"))
 (princ)
)
(princ "\nType E2P to run command")

 

PS. Corrected

  • 4 years later...
tzframpton Grand Master

tzframpton

Posted
Posted
I'm not sure about a LISP but you can draw them as PLINES in the first place....

 

PELLIPSE System Variable
Type: IntegerSaved in: DrawingInitial value: 0
Controls the ellipse type created with ELLIPSE.
0
Creates a true ellipse object.
1
Creates a polyline representation of an ellipse

Man I love the search function on this site. A post made 4.5 years ago just made my day. :)

  • 11 years later...
VVA1 Newbie

VVA1

Posted
Posted

Another version. Converts elliptical arcs as well 

(defun C:E2P (/ adoc el ssnab en item lays lay lock pell pl)
  ;;; Convert ellipses to polylines (including elliptical arcs)
  ;;; https://forum.dwg.ru/showthread.php?p=73508#post73508
  ;;;https://www.cadtutor.net/forum/topic/597-lisp-for-converting-ellipse-to-polylines/
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq lays (vla-get-layers adoc))
  (vla-startundomark adoc)
  (setq ssnab (ssget '((0 . "ELLIPSE"))))
  (while (and ssnab
	      (> (sslength ssnab) 0)
	 )
    (setq el (ssname ssnab 0))
    (setq en (vlax-ename->vla-object el))
    (setq lay (vla-item lays (vla-get-layer en)))
    (if	(= (vla-get-lock lay) :vlax-true)
      (progn (vla-put-lock lay :vlax-false)
	     (setq lock (cons lay lock))
      ))
    (setq item (vla-get-ObjectName en))
    (cond
      ((= item "AcDbEllipse")
       (ace2arcpl en)
       (mapcar
	 '(lambda (x y)
	    (vlax-put-property (vlax-ename->vla-object (entlast)) x y)
	  )
	 '(Linetype LineWeight Color Layer)
	 (mapcar '(lambda (x)
		    (vlax-get-property en x)
		  )
		 '(Linetype LineWeight Color Layer)
	 )
       )
       (vla-Delete en)
       )
      (t nil)
    )
    (ssdel el ssnab)
  )
  (if lock
    (foreach x lock (vla-put-lock x :vlax-true))
  )
  (vla-endundomark adoc)
  (princ "\nEllipse transformation completed")
  (princ)
)
(defun LM:3ppolyarc (  pt1 pt2 pt3 / ocs  )
  ;;http://lee-mac.com/3pointarccircle.html
  (setq ocs '(0 0 1))
  (entmakex
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
               '(090 . 2)
               '(070 . 0)
                (cons 038 (caddr pt1))
                (cons 010 pt1)
                (cons 042 (LM:3p->bulge pt1 pt2 pt3))
                (cons 010 pt3)
                (cons 210 ocs)
            )
        )
 )
;;; 3-Points to Bulge  -  Lee Mac
(defun LM:3p->bulge ( pt1 pt2 pt3 )
    ((lambda ( a ) (/ (sin a) (cos a))) (/ (+ (- pi (angle pt2 pt1)) (angle pt2 pt3)) 2))
)
(defun NormalAngle (a)
;-------------------------------------------
;; Argument: angle in radians, any number including negative.
;; Returns: normalized angle in radians between zero and (* pi 2)
  (if (numberp a)(angtof (angtos a 0 14) 0)))
(defun TraceACE (obj / startparam endparam anginc 
                         delta div inc pt ptlst)
    ;start and end angles
    ;circles don't have StartAngle and EndAngle properties.
    (setq startparam (vlax-curve-getStartParam obj)
          endparam (vlax-curve-getEndParam obj)
          anginc (* pi (/ 5.0 180.0))
    )
    (if (equal endparam (* pi 2) 1e-12)
      (setq delta endparam)
      (setq delta (NormalAngle (- endparam startparam)))
    )
    ;Divide delta (included angle) into an equal number of parts.
    (setq div (1+ (fix (/ delta anginc)))
          inc (/ delta div)
    )
    ;Or statement allows the last point on an open ellipse
    ;rather than using (<= startparam endparam) which sometimes
    ;fails to return the last point. Not sure why.
    (while
      (or
        (< startparam endparam)
        (equal startparam endparam 1e-12)
      )
      (setq pt (vlax-curve-getPointAtParam obj startparam)
            ptlst (cons pt ptlst)
            startparam (+ inc startparam)
      )
    )
    (reverse ptlst)
  )
(defun ace2arcpl ( obj / a ptlst n startparam endparam midpt anab el)
  (vl-load-com)
;;; Argument: vla-object, an arc, circle or ellipse.
;;; Returns: WCS point list if successful.
(setq el (vlax-vla-object->ename obj) ptlst (reverse (TraceACE obj)))
 (if (and 
         (= (cdr(assoc 0 (entget el))) "ELLIPSE")
         (zerop(cdr(assoc 41 (entget el))))
         (equal (cdr(assoc 42 (entget el))) (* 2 pi) 1e-6)
         )
   (setq ptlst (cdr ptlst)) ;;; Full ellipse
   )
(setq n 0 anab nil anab (ssadd)) ; anab nil
(while (< n (1- (length ptlst)))
(setq startparam (vlax-curve-getParamAtPoint obj (nth n ptlst))
endparam (vlax-curve-getParamAtPoint obj (nth (1+ n) ptlst))
midpt (vlax-curve-getPointAtParam obj (+ startparam (/ (- endparam startparam) 2)))
)
(setq a (LM:3ppolyarc (nth n ptlst) midpt (nth (1+ n) ptlst)))
(ssadd a anab)
(setq n (1+ n))
)
(setq a (vl-cmdf "_PEDIT" "_Multiple" anab "" "_Join" 0 ""))
(setq anab nil)
(princ)
(entlast)
) ; _ defun ace2arcpl
(princ "\nType E2P in command line")(princ)

 

Steven P Grand Master

Steven P

Posted
Posted
On 8/8/2011 at 2:57 PM, tzframpton said:

Man I love the search function on this site. A post made 4.5 years ago just made my day. :)

 

 

Well, your going to love this one.....

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...