Convert ellipses to polylines

Convert ellipses to polylines · 15.05.2006, 16:02

Никак не могу эллипсы преобразовать в полилинию. Может кто-ть знает как?....Получается только при помощи Toolpac'a конвертировать эллипс в Plines....но это не пойдет, т.к. кривую он делит на множество прямых линий...

Кулик Алексей aka kpblc · 15.05.2006, 16:05

Нереально. У полилинии нет эллиптических сегментов. Соответственно все варианты - это либо прямые, либо дуговые сегменты с бОльшей или меньшей степенью детализации

asys · 15.05.2006, 16:06

поставь PELLIPSE в 1 и элипсы будут рисоваться полилиниями

Profan · 15.05.2006, 16:51

Для Amaru.
Если эллипс уже нарисован, то можно поделить его командой "_DIVIDE"
и обвести на другом слое дуговыми сегментами полилинии с использованием
привязок "_nod" ("узел") и "_nea" ("бли"). Последняя привязка нужна для
использования второй точки при отрисовки дуговых сегментов и большей
точности. Количество точек деления влияет на точность аппроксимации.

Om81 · 15.05.2006, 17:03

Единственное, чтобы при этом получить гладкую кривую (без переломов), имитирующую эллипс, нужно правильно построить сопряжения дуг (окружностей). Необходимо, чтобы оба центра окружностей и точка пересечения дуг лежали на одной прямой..

Amaru · 15.05.2006, 17:30

Всем спасибо.....
to Profan этим счас и занимаюсь )....уж очень много отрисовывать....

VVA · 16.05.2006, 09:47

>Amaru
http://forum.dwg.ru/showthread.php?t=6557
Преобразуй эллипсы в регионы и используй команду EXP_REGION из №6

VVA · 16.05.2006, 10:01

Вот специально для эллипсов

Код:

[Выделить все]

(defun C:E2P (/ adoc el ssnab en item lays lay lock pell pl)
  ;;; Эллипсы в полилинию (включая неполные)
  ;;; https://forum.dwg.ru/showthread.php?p=73508#post73508
  (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")))) ;_Выбор Ellips'ов в рисунке
  (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 "\nПреобразование Ellipse завершено")
  (princ)
)
(defun C:E2PCMD (/ adoc el ssnab en item lays lay lock pell ptcen)
  ;;; Эллипсы в полилинию (включая неполные)
  ;;; https://forum.dwg.ru/showthread.php?p=73508#post73508
  (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")))) ;_Выбор Ellips'ов в рисунке
  (setq pell (getvar "PELLIPSE"))
  (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
      ((and
         (= item "AcDbEllipse")
         (zerop(cdr(assoc 41 (entget el))))
         (equal (cdr(assoc 42 (entget el))) (* 2 pi) 1e-6)
         ;;; Полный эллипс
         )
       (setq ptcen (vlax-safearray->list
		     (vlax-variant-value (vla-get-center en))
		   )
       )
       (command	"_ellipse"  "_C" "_non" ptcen
                "_non"
		(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)
      )
      ((= item "AcDbEllipse")
      ;;; Неполный эллипс
       (ace2arcpl en)
       (vla-Delete en)
       )
      (t nil)
    )
    (ssdel el ssnab)
  )
  (setvar "PELLIPSE" pell)
  (if lock
    (foreach x lock (vla-put-lock x :vlax-true))
  )
  (vla-endundomark adoc)
  (princ "\nПреобразование Ellipse завершено")
  (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 (/ 4.0 180.0)) ;_(* pi (/ 5.0 180.0))
    )
    (if (or
           (equal endparam (* pi 2) 1e-12)
           (equal (- endparam startparam) (* pi 2) 1e-12)
           )
      (setq delta endparam)
      (setq delta (NormalAngle (- endparam startparam)))
    )
  (if (zerop delta)(setq delta (* pi 2)))
    ;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")
         (equal (vlax-get obj 'startpoint) (vlax-get obj  'endpoint) 1e-6)
;;;         (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))
)
  (if (and 
         (= (cdr(assoc 0 (entget el))) "ELLIPSE")
         (equal (vlax-get obj 'startpoint) (vlax-get obj  'endpoint) 1e-6)
;;;         (zerop(cdr(assoc 41 (entget el))))
;;;         (equal (cdr(assoc 42 (entget el))) (* 2 pi) 1e-6)
         )
    (progn ;;; Full ellipse
      (setq midpt (polar (last ptlst)(angle (last ptlst)(car ptlst))(* 0.5(distance (last ptlst)(car ptlst)))))
      (setq midpt (vlax-curve-getClosestPointTo obj midpt)) 
      (setq a (LM:3ppolyarc (last ptlst) midpt (car ptlst)))
      (ssadd a anab)
   )
   )
(setq a (vl-cmdf "_PEDIT" "_Multiple" anab "" "_Join" 0 ""))
(setq anab nil)
(princ)
(entlast)
) ; _ defun ace2arcpl
(princ "\nНаберите в ком. строке E2P или E2PCMD")(princ)

Код от GILE - Gilles Chanteau (перенесен в #11)

Amaru · 16.05.2006, 15:46

To VVA Огромное спасибо...правда я уже все вручную переделал (...но теперь все время этой темой буду пользоваться!!!! Суперская вещь!!!!!! )))

antonio_k · 21.10.2009, 15:31

классный лисп,но вот если у меня только сегмент эллипса, а лисп дорисовывает недостающие части круговыми дугами которые мне приходится впоследствие удалять,как быть?
просто задача у меня такая: есть набор линий, полилиний,частей эллипсов которые между собой последовательно соединены,мне же нужно все это превратить в полилинию,когда дохожу до эллипсов начинаються траблы
помогите кто может)))

VVA · 21.10.2009, 19:03

Проблема в том, что когда PELLIPSE=1, то в команде _ELLIPSE отсутствует опция _ARC (Дуга). Т.е. в режиме отрисовки эллипсов полилиниями (PELLIPSE=1) можно рисовать только полные эллипсы.

Код от GILE - Gilles Chanteau (перенесен из #8)

Код:

[Выделить все]

;;; GILE - Gilles Chanteau
;;; ellipse to polyline
;;; эллипс в полилинию
;;; http://www.cadtutor.net/forum/showthread.php?63520-Trimed-ellipse-to-Polyline
;;; http://www.theswamp.org/index.php?topic=30892.msg364454#msg364454
;; EL2PL
;; Converts ellipses and elliptcal arcs into polylines

(defun c:el2pl (/ *error* fra acdoc ss)
  (vl-load-com)
  
  (defun *error* (msg)
    (if (and (/= msg "Fonction annulйe")
             (/= msg "Function cancelled")
        )
      (princ (strcat (if (= "FRA" (getvar 'locale))
                       "\nErreur: "
                       "\Error: "
                     )
                     msg
             )
      )
    )
    (vla-endUndoMark acdoc)
    (princ)
  )
  (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if (ssget '((0 . "ELLIPSE")))
    (progn
      (vla-StartUndoMark acdoc)
      (vlax-for e (setq ss (vla-get-ActiveSelectionSet acdoc))
        (EllipseToPolyline e)
        (vla-delete e)
      )
      (vla-delete ss)
      (vla-EndUndoMark acdoc)
    )
  )
  (princ)
)

;; PELL
;; Draws an ellipse or an elliptical arc approximation (polyline) on the fly
(defun c:pell (/ *error* ec pe old ent)

  (vl-load-com)
  
  (defun *error* (msg)
    (if (and msg
             (/= msg "Fonction annulйe")
             (/= msg "Function cancelled")
        )
      (princ (strcat (if (= "FRA" (getvar 'locale))
                       "\nErreur: "
                       "\Error: "
                     )
                     msg
             )
      )
    )
    (setvar 'cmdecho ec)
    (setvar 'pellipse pe)
    (princ)
  )
  (setq ec  (getvar 'cmdecho)
        pe  (getvar 'pellipse)
        old (entlast)
  )
  (setvar 'cmdecho 1)
  (setvar 'pellipse 0)
  (command "_.ellipse")
  (while (/= 0 (getvar 'cmdactive))
    (command pause)
  )
  (if (not (eq old (setq ent (entlast))))
    (progn
    (EllipseToPolyline (vlax-ename->vla-object ent))
    (entdel ent)
    )
  )
  (*error* nil)
)
;; EllipseToPolyline
;; Returns a polyline (vla-object) which is an approximation of the ellipse (or elliptical arc)
;;
;; Argument : an ellipse (vla-object)

(defun EllipseToPolyline (el	/     cl    norm  cen	elv   pt0   pt1	  pt2	pt3   pt4   ac0
			  ac4	a04   a02   a24	  bsc0	bsc2  bsc3  bsc4  plst	blst  spt   spa
			  fspa	srat  ept   epa	  fepa	erat  n
			 )
  (vl-load-com)
  (setq	cl   (= (ang<2pi (vla-get-StartAngle el))
		(ang<2pi (vla-get-EndAngle el)))
	norm (vlax-get el 'Normal)
	cen  (trans (vlax-get el 'Center) 0 norm)
	elv  (caddr cen)
	cen  (3dTo2dPt cen)
	pt0  (mapcar '+ (trans (vlax-get el 'MajorAxis) 0 norm) cen)
	ac0  (angle cen pt0)
	pt4  (mapcar '+ cen (trans (vlax-get el 'MinorAxis) 0 norm))
	pt2  (3dTo2dPt (trans (vlax-curve-getPointAtparam el (/ pi 4.)) 0 norm))
	ac4  (angle cen pt4)
	a04  (angle pt0 pt4)
	a02  (angle pt0 pt2)
	a24  (angle pt2 pt4)
	bsc0 (/ (ang<2pi (- a02 ac4)) 2.)
	bsc2 (/ (ang<2pi (- a04 a02)) 2.)
	bsc3 (/ (ang<2pi (- a24 a04)) 2.)
	bsc4 (/ (ang<2pi (- (+ ac0 pi) a24)) 2.)
	pt1  (inters pt0
		     (polar pt0 (+ ac0 (/ pi 2.) bsc0) 1.)
		     pt2
		     (polar pt2 (+ a02 bsc2) 1.)
		     nil
	     )
	pt3  (inters pt2
		     (polar pt2 (+ a04 bsc3) 1.)
		     pt4
		     (polar pt4 (+ a24 bsc4) 1.)
		     nil
	     )
	plst (list pt4 pt3 pt2 pt1 pt0)
	blst (mapcar '(lambda (b) (tan (/ b 2.)))
		     (list bsc4 bsc3 bsc2 bsc0)
	     )
  )
  (foreach b blst
    (setq blst (cons b blst))
  )
  (foreach b blst
    (setq blst (cons b blst))
  )
  (foreach p (cdr plst)
    (setq ang  (angle cen p)
	  plst (cons
		 (polar cen (+ ang (* 2 (- ac4 ang))) (distance cen p))
		 plst
	       )
    )
  )
  (foreach p (cdr plst)
    (setq ang  (angle cen p)
	  plst (cons
		 (polar cen (+ ang (* 2 (- ac0 ang))) (distance cen p))
		 plst
	       )
    )
  )
  (setq	pl
	 (vlax-invoke
	   (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
	   'AddLightWeightPolyline
	   (apply 'append
		  (setq	plst
			 (reverse (if cl
				    (cdr plst)
				    plst
				  )
			 )
		  )
	   )
	 )
  )
  (vlax-put pl 'Normal norm)
  (vla-put-Elevation pl elv)
  (mapcar '(lambda (i v) (vla-SetBulge pl i v))
	  '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16)
	  blst
  )
  (if cl
    (vla-put-Closed pl :vlax-true)
    (progn
      (setq spt	 (vlax-curve-getClosestPointTo pl (vlax-get el 'Startpoint))
	    spa	 (vlax-curve-getParamAtPoint pl spt)
	    fspa (fix spa)
	    ept	 (vlax-curve-getClosestPointTo pl (vlax-get el 'Endpoint))
	    epa	 (vlax-curve-getParamAtPoint pl ept)
	    fepa (fix epa)
	    n	 0
      )
      (cond
	((equal spt (trans pt0 norm 0) 1e-9)
	 (if (= epa fepa)
	   (setq plst (sublist plst 0 (1+ fepa))
		 blst (sublist blst 0 (1+ fepa))
	   )
	   (setq erat (/ (- (vlax-curve-getDistAtParam pl epa)
			    (vlax-curve-getDistAtParam pl fepa)
			 )
			 (- (vlax-curve-getDistAtParam pl (rem (1+ fepa) 17))
			    (vlax-curve-getDistAtParam pl fepa)
			 )
		      )
		 plst (append (sublist plst 0 (1+ fepa))
			      (list (3dTo2dPt (trans ept 0 norm)))
		      )
		 blst (append (sublist blst 0 (1+ fepa))
			      (list (k*bulge (nth fepa blst) erat))
		      )
	   )
	 )
	)
	((equal ept (trans pt0 norm 0) 1e-9)
	 (if (= spa fspa)
	   (setq plst (sublist plst fspa nil)
		 blst (sublist blst fspa nil)
	   )
	   (setq srat (/ (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
			    (vlax-curve-getDistAtParam pl spa)
			 )
			 (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
			    (vlax-curve-getDistAtParam pl fspa)
			 )
		      )
		 plst (cons (3dTo2dPt (trans spt 0 norm))
			    (sublist plst (1+ fspa) nil)
		      )
		 blst (cons (k*bulge (nth fspa blst) srat)
			    (sublist blst (1+ fspa) nil)
		      )
	   )
	 )
	)
	(T
	 (setq srat (/ (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
			  (vlax-curve-getDistAtParam pl spa)
		       )
		       (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
			  (vlax-curve-getDistAtParam pl fspa)
		       )
		    )
	       erat (/ (- (vlax-curve-getDistAtParam pl epa)
			  (vlax-curve-getDistAtParam pl fepa)
		       )
		       (- (vlax-curve-getDistAtParam pl (rem (1+ fepa) 17))
			  (vlax-curve-getDistAtParam pl fepa)
		       )
		    )
	 )
	 (if (< epa spa)
	   (setq plst (append
			(if (= spa fspa)
			  (sublist plst fspa nil)
			  (cons	(3dTo2dPt (trans spt 0 norm))
				(sublist plst (1+ fspa) nil)
			  )
			)
			(cdr (sublist plst 0 (1+ fepa)))
			(if (/= epa fepa)
			  (list (3dTo2dPt (trans ept 0 norm)))
			)
		      )
		 blst (append
			(if (= spa fspa)
			  (sublist blst fspa nil)
			  (cons
			    (k*bulge (nth fspa blst) srat)
			    (sublist blst (1+ fspa) nil)
			  )
			)
			(sublist blst 0 fepa)
			(if (= epa fepa)
			  (list (nth fepa blst))
			  (list (k*bulge (nth fepa blst) erat))
			)
		      )
	   )
	   (setq plst (append
			(if (= spa fspa)
			  (sublist plst fspa (1+ (- fepa fspa)))
			  (cons	(3dTo2dPt (trans spt 0 norm))
				(sublist plst (1+ fspa) (- fepa fspa))
			  )
			)
			(list (3dTo2dPt (trans ept 0 norm)))
		      )
		 blst (append
			(if (= spa fspa)
			  (sublist blst fspa (- fepa fspa))
			  (cons
			    (k*bulge (nth fspa blst) srat)
			    (sublist blst (1+ fspa) (- fepa fspa))
			  )
			)
			(if (= epa fepa)
			  (list (nth fepa blst))
			  (list (k*bulge (nth fepa blst) erat))
			)
		      )
	   )
	 )
	)
      )
      (vlax-put pl 'Coordinates (apply 'append plst))
      (foreach b blst
	(vla-SetBulge pl n b)
	(setq n (1+ n))
      )
    )
  )
  pl
)

;; Ang<2pi
;; Returns the angle expression betweem 0 and 2*pi
(defun ang<2pi (ang)
  (if (and (<= 0 ang) (< ang (* 2 pi)))
    ang
    (ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi)))
  )
)

;; 3dTo2dPt
;; Returns the 2d point (x y) of a 3d point (x y z)
(defun 3dTo2dPt (pt) (list (car pt) (cadr pt)))

;; Tan
;; Returns the angle tangent
(defun tan (a) (/ (sin a) (cos a)))

;; SUBLIST 
;; Returns a sub list
;;
;; Arguments
;; lst : a list
;; start : start index (first item = 0)
;; leng : the sub list length (number of items) or nil
(defun sublist (lst start leng / n r)
  (if (or (not leng) (< (- (length lst) start) leng))
    (setq leng (- (length lst) start))
  )
  (setq n (+ start leng))
  (while (< start n)
    (setq r (cons (nth (setq n (1- n)) lst) r))
  )
)

;; K*BULGE
;; Returns the proportinal bulge to the reference bulge
;; Arguments :
;; b : the bulge
;; k : the proportion ratio (between angles or arcs length)
(defun k*bulge (b k / a)
  (setq a (atan b))
  (/ (sin (* k a)) (cos (* k a)))
)

(princ "\nType in command line:")
(princ "\nPELL - Creats a polyline figuring an ellipse (or an elliptical arc)")
(princ "\nEL2PL - Change ellipses (or an elliptical arc) into polylines")
(princ)

АлексЮстасу · 05.01.2023, 22:44

Цитата:

Сообщение от VVA

Вот специально для эллипсов

Столкнулся с эллиптическими дугами, которые нужно сшивать с полилиниями. (После воссоздания контуров штриховок).
Лисп от GILE - Gilles Chanteau их преобразует в полилинии дуговыми сегментами, но грубовато.
Что можно поменять в его лиспе, чтобы вершин в заменяющей полилинии было побольше?

На второй картинке обведено желтым - видно расхождение между положением конца эллиптической дуги и концом заменяющей полилинии.

zvezdochiot · 06.01.2023, 11:54

Цитата:

Сообщение от АлексЮстасу

Лисп от GILE - Gilles Chanteau их преобразует в полилинии дуговыми сегментами, но грубовато.
Что можно поменять в его лиспе, чтобы вершин в заменяющей полилинии было побольше?

В

Код:

[Выделить все]

  (mapcar '(lambda (i v) (vla-SetBulge pl i v))
	  '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16)
	  blst

цифирь после 16 добавить не пробовал? Навскидку, но возможно, что в цель.

АлексЮстасу · 06.01.2023, 15:57

Цитата:

Сообщение от zvezdochiot

цифирь после 16 добавить не пробовал? Навскидку, но возможно, что в цель.

Пробовал. Плачет.

Кулик Алексей aka kpblc · 06.01.2023, 16:00

Цитата:

Сообщение от АлексЮстасу

Столкнулся с эллиптическими дугами, которые нужно сшивать с полилиниями. (После воссоздания контуров штриховок).
Лисп от GILE - Gilles Chanteau их преобразует в полилинии дуговыми сегментами, но грубовато.
Что можно поменять в его лиспе, чтобы вершин в заменяющей полилинии было побольше?

На второй картинке обведено желтым - видно расхождение между положением конца эллиптической дуги и концом заменяющей полилинии.

Это просто прекрасно. А проблемный код где?

АлексЮстасу · 06.01.2023, 16:57

Цитата:

Сообщение от Кулик Алексей aka kpblc

А проблемный код где?

В смысле? Пяток постов выше, на этой странице, #8, от GILE - Gilles Chanteau.

zvezdochiot · 06.01.2023, 20:08

Цитата:

Сообщение от АлексЮстасу

Пробовал. Плачет.

Плачет говоришь? Так наверное все "17"-шки далее надо переправить на последнюю цифру в ряде + 1. Тоже не?

АлексЮстасу · 06.01.2023, 20:23

Цитата:

Сообщение от zvezdochiot

Так наверное все "17"-шки далее надо переправить на последнюю цифру в ряде + 1. Тоже не?

Плачет.

zvezdochiot · 06.01.2023, 20:56

Цитата:

Сообщение от АлексЮстасу

Плачет.

Тогда никак. Потому что всё сидит в этих:

Код:

[Выделить все]

	ac4  (angle cen pt4)
	a04  (angle pt0 pt4)
	a02  (angle pt0 pt2)
	a24  (angle pt2 pt4)

четырёх точках. Вам получается нужен скрипт, который увеличит число точек на самом эллипсе/сплайне.

АлексЮстасу · 17.06.2023, 21:05

Цитата:

Сообщение от АлексЮстасу

Лисп от GILE - Gilles Chanteau их преобразует в полилинии дуговыми сегментами, но грубовато.
Что можно поменять в его лиспе, чтобы вершин в заменяющей полилинии было побольше?

Мне написали такой фрагмент:

(defun mb:ace2arcpl ( obj / a ptlst n startparam endparam midpt anab pacc)
(setq ptlst (reverse (TraceACE obj)))
(setq pacc (getvar "PEDITACCEPT"))
(setvar "PEDITACCEPT" 1)
(setq n 0 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 (vl-cmdf "_.ARC" "_none" (nth n ptlst) "_none" midpt "_none" (nth (1+ n) ptlst)))
(ssadd (entlast) anab)
(setq n (1+ n))
)
(setq a (vl-cmdf "_PEDIT" "_Multiple" anab "" "_Join" 0 ""))
(setq anab nil)
(setvar "PEDITACCEPT" pacc)
(princ)
(entlast)
) ; _ defun _ mb:ace2arcpl

В лиспе решена проблема с неточностью получаемых полилиний - расхождений пока не заметил.
К сожалению, два "но": может вылетать на цельных эллипсах и работает оч. медленно.
Низкая скорость, наверное, из-за командных методов создания дуг и их сшивания.
Может кто-нибудь подправить, чтобы снять эти засады? [Я не программист.]

15.05.2006, 16:02		#1
Convert ellipses to polylines Amaru Зеленоград Регистрация: 03.03.2006 Сообщений: 3 Никак не могу эллипсы преобразовать в полилинию. Может кто-ть знает как?....Получается только при помощи Toolpac'a конвертировать эллипс в Plines....но это не пойдет, т.к. кривую он делит на множество прямых линий...
Просмотров: 10315