Реклама i
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Convert ellipses to polylines

Convert ellipses to polylines

Ответ
Поиск в этой теме
Непрочитано 15.05.2006, 16:02 #1
Convert ellipses to polylines
Amaru
 
Зеленоград
Регистрация: 03.03.2006
Сообщений: 3

Никак не могу эллипсы преобразовать в полилинию. Может кто-ть знает как?....Получается только при помощи Toolpac'a конвертировать эллипс в Plines....но это не пойдет, т.к. кривую он делит на множество прямых линий...
Просмотров: 9269
 
Непрочитано 15.05.2006, 16:05
#2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,591


Нереально. У полилинии нет эллиптических сегментов. Соответственно все варианты - это либо прямые, либо дуговые сегменты с бОльшей или меньшей степенью детализации
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 15.05.2006, 16:06
1 | #3
asys

архитектор
 
Регистрация: 10.08.2005
Ростов-на-Дону
Сообщений: 5,273


поставь PELLIPSE в 1 и элипсы будут рисоваться полилиниями
asys вне форума  
 
Непрочитано 15.05.2006, 16:51
#4
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


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

Хочу быть фотографом :)
 
Регистрация: 21.10.2005
Москва, Кисловодск
Сообщений: 2,538
<phrase 1=


Единственное, чтобы при этом получить гладкую кривую (без переломов), имитирующую эллипс, нужно правильно построить сопряжения дуг (окружностей). Необходимо, чтобы оба центра окружностей и точка пересечения дуг лежали на одной прямой..
__________________
Камень на камень, кирпич на кирпич..
Om81 вне форума  
 
Автор темы   Непрочитано 15.05.2006, 17:30
#6
Amaru


 
Регистрация: 03.03.2006
Зеленоград
Сообщений: 3


Всем спасибо.....
to Profan этим счас и занимаюсь )....уж очень много отрисовывать....
Amaru вне форума  
 
Непрочитано 16.05.2006, 09:47
#7
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,981
<phrase 1= Отправить сообщение для VVA с помощью Skype™


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

Последний раз редактировалось VVA, 14.10.2011 в 15:29.
VVA вне форума  
 
Непрочитано 16.05.2006, 10:01
#8
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,981
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Вот специально для эллипсов
Код:
[Выделить все]
(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)

Последний раз редактировалось VVA, 05.07.2023 в 13:32. Причина: Внесены изменения см #38
VVA вне форума  
 
Автор темы   Непрочитано 16.05.2006, 15:46
#9
Amaru


 
Регистрация: 03.03.2006
Зеленоград
Сообщений: 3


To VVA Огромное спасибо...правда я уже все вручную переделал (...но теперь все время этой темой буду пользоваться!!!! Суперская вещь!!!!!! )))
Amaru вне форума  
 
Непрочитано 21.10.2009, 15:31
#10
antonio_k

проектирование автомобильных дорог
 
Регистрация: 03.02.2009
Киев
Сообщений: 144
<phrase 1=


классный лисп,но вот если у меня только сегмент эллипса, а лисп дорисовывает недостающие части круговыми дугами которые мне приходится впоследствие удалять,как быть?
просто задача у меня такая: есть набор линий, полилиний,частей эллипсов которые между собой последовательно соединены,мне же нужно все это превратить в полилинию,когда дохожу до эллипсов начинаються траблы
помогите кто может)))
antonio_k вне форума  
 
Непрочитано 21.10.2009, 19:03
#11
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,981
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Проблема в том, что когда 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)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 29.06.2023 в 11:06.
VVA вне форума  
 
Непрочитано 05.01.2023, 22:44
#12
АлексЮстасу

топограф, технолог
 
Блог
 
Регистрация: 24.05.2009
Москва
Сообщений: 3,041


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

На второй картинке обведено желтым - видно расхождение между положением конца эллиптической дуги и концом заменяющей полилинии.
Миниатюры
Нажмите на изображение для увеличения
Название: Эллиптическая_дуга.png
Просмотров: 58
Размер:	28.7 Кб
ID:	252412  Нажмите на изображение для увеличения
Название: Эллиптическая_дуга_подробность.png
Просмотров: 59
Размер:	38.8 Кб
ID:	252413  
__________________
количество моих сообщений не говорит о знании Автокада
АлексЮстасу вне форума  
 
Непрочитано 06.01.2023, 11:54
#13
zvezdochiot

маркшейдер
 
Регистрация: 25.09.2021
Москва
Сообщений: 156


Цитата:
Сообщение от АлексЮстасу Посмотреть сообщение
Лисп от 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 добавить не пробовал? Навскидку, но возможно, что в цель.
__________________
Keep it simple, stupid.
zvezdochiot вне форума  
 
Непрочитано 06.01.2023, 15:57
#14
АлексЮстасу

топограф, технолог
 
Блог
 
Регистрация: 24.05.2009
Москва
Сообщений: 3,041


Цитата:
Сообщение от zvezdochiot Посмотреть сообщение
цифирь после 16 добавить не пробовал? Навскидку, но возможно, что в цель.
Пробовал. Плачет.
__________________
количество моих сообщений не говорит о знании Автокада
АлексЮстасу вне форума  
 
Непрочитано 06.01.2023, 16:00
#15
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,591


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

На второй картинке обведено желтым - видно расхождение между положением конца эллиптической дуги и концом заменяющей полилинии.
Это просто прекрасно. А проблемный код где?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 06.01.2023, 16:57
#16
АлексЮстасу

топограф, технолог
 
Блог
 
Регистрация: 24.05.2009
Москва
Сообщений: 3,041


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
А проблемный код где?
В смысле? Пяток постов выше, на этой странице, #8, от GILE - Gilles Chanteau.
__________________
количество моих сообщений не говорит о знании Автокада
АлексЮстасу вне форума  
 
Непрочитано 06.01.2023, 20:08
#17
zvezdochiot

маркшейдер
 
Регистрация: 25.09.2021
Москва
Сообщений: 156


Цитата:
Сообщение от АлексЮстасу Посмотреть сообщение
Пробовал. Плачет.
Плачет говоришь? Так наверное все "17"-шки далее надо переправить на последнюю цифру в ряде + 1. Тоже не?
__________________
Keep it simple, stupid.
zvezdochiot вне форума  
 
Непрочитано 06.01.2023, 20:23
#18
АлексЮстасу

топограф, технолог
 
Блог
 
Регистрация: 24.05.2009
Москва
Сообщений: 3,041


Цитата:
Сообщение от zvezdochiot Посмотреть сообщение
Так наверное все "17"-шки далее надо переправить на последнюю цифру в ряде + 1. Тоже не?
Плачет.
__________________
количество моих сообщений не говорит о знании Автокада
АлексЮстасу вне форума  
 
Непрочитано 06.01.2023, 20:56
#19
zvezdochiot

маркшейдер
 
Регистрация: 25.09.2021
Москва
Сообщений: 156


Цитата:
Сообщение от АлексЮстасу Посмотреть сообщение
Плачет.
Тогда никак. Потому что всё сидит в этих:
Код:
[Выделить все]
	ac4  (angle cen pt4)
	a04  (angle pt0 pt4)
	a02  (angle pt0 pt2)
	a24  (angle pt2 pt4)
четырёх точках. Вам получается нужен скрипт, который увеличит число точек на самом эллипсе/сплайне.
__________________
Keep it simple, stupid.
zvezdochiot вне форума  
 
Непрочитано 17.06.2023, 21:05
#20
АлексЮстасу

топограф, технолог
 
Блог
 
Регистрация: 24.05.2009
Москва
Сообщений: 3,041


Цитата:
Сообщение от АлексЮстасу Посмотреть сообщение
Лисп от 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

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

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,981
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Не хватает функции TraceACE

----- добавлено через ~8 мин. -----
Еще вариант отсюда (требуется регистрация)

Код:
[Выделить все]
;;Ellipses to polylines By cjw 11/9/09
(defun C:EL2PL2 (/ E E1 E2 O)
  (vl-load-com)
  (setq E (car (entsel "\nSelect the ellipse: ")))
  (setq O (vlax-ename->vla-object E))
  (vla-offset O 0.1)
  (setq E1 (entlast))
  (vla-offset (vlax-ename->vla-object E1) -0.1)
  (setq E2 (entlast))
  (entdel E)
  (entdel E1)
  (princ)
)
Эллипсы преобразуются в сплайны. Правая кнопка мыши на сплайне -> Преобразовать в полилинию
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 19.06.2023, 17:00
#22
АлексЮстасу

топограф, технолог
 
Блог
 
Регистрация: 24.05.2009
Москва
Сообщений: 3,041


Цитата:
Сообщение от VVA Посмотреть сообщение
Не хватает функции TraceACE
Ее хватает - из Вашего же PlTools. Приведенный мной фрагмент используется в программе.
Мой вопрос был о точности. Программа от Gile из Вашего #8 делала не точный контур. Приведенный мной фрагмент дает точный контур. Дуговые сегменты позволяют ее достичь.
Но работает медленно. Или не работает.
__________________
количество моих сообщений не говорит о знании Автокада
АлексЮстасу вне форума  
 
Непрочитано 27.06.2023, 11:07
#23
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,981
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от АлексЮстасу Посмотреть сообщение
Но работает медленно. Или не работает.
Обновил команду E2P в #8
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 27.06.2023, 11:59
#24
AlexCondor

инженер
 
Регистрация: 03.08.2007
Сообщений: 1,316


Цитата:
Сообщение от VVA Посмотреть сообщение
Обновил команду E2P
Попробовал в 2014-м. На полных эллипсах работает, а на не полных пишет - "; error: no function definition: NORMALANGLE"
AlexCondor вне форума  
 
Непрочитано 27.06.2023, 13:13
1 | #25
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,981
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Обновил #8
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 27.06.2023, 18:24
#26
АлексЮстасу

топограф, технолог
 
Блог
 
Регистрация: 24.05.2009
Москва
Сообщений: 3,041


Цитата:
Сообщение от VVA Посмотреть сообщение
Обновил #8
У меня как раз на полных эллипсах E2P задумывается напрочь.
__________________
количество моих сообщений не говорит о знании Автокада

Последний раз редактировалось АлексЮстасу, 27.06.2023 в 20:26.
АлексЮстасу вне форума  
 
Непрочитано 28.06.2023, 11:29
#27
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,981
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от АлексЮстасу Посмотреть сообщение
У меня как раз на полных эллипсах E2P задумывается напрочь
Там командный метод
На полных эллипсах вроде код Gile не отличается от команды эллипс с PELLIPSE=1
Обновил #8
E2P - для полных эллипсов используется ф-ция gile
E2PCMD - полные эллипсы строятся командным методом (PELLIPSE=1)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 28.06.2023, 19:53
#28
АлексЮстасу

топограф, технолог
 
Блог
 
Регистрация: 24.05.2009
Москва
Сообщений: 3,041


Цитата:
Сообщение от VVA Посмотреть сообщение
E2P - для полных эллипсов используется ф-ция gile
E2PCMD - полные эллипсы строятся командным методом (PELLIPSE=1)
Пардон, не догоняю...
Обе команды одинаково преобразуют эллиптические дуги. И обе же одинаково зависают на полных эллипсах.
В принципе, зачем две команды? Тем более, что они делают/не делают одинаково...
__________________
количество моих сообщений не говорит о знании Автокада
АлексЮстасу вне форума  
 
Непрочитано 29.06.2023, 10:30
#29
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,981
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Отличие в методах. В команде E2PCMD используется команда "Эллипс" с установкой pellipse=1, в команде E2P функция gile (считается геометрически). Выложи или пришли пример, в котором виснет.

----- добавлено через ~39 мин. -----
АлексЮстасу, Я еще раз обновил #8 Отказался от ф-ции gile для полных эллипсов. Пересмотрел граничные условия для написанной ф-ции для неполных элипсов. Тестируй
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 29.06.2023 в 12:07.
VVA вне форума  
 
Непрочитано 29.06.2023, 17:01
#30
АлексЮстасу

топограф, технолог
 
Блог
 
Регистрация: 24.05.2009
Москва
Сообщений: 3,041


Цитата:
Сообщение от VVA Посмотреть сообщение
еще раз обновил #8
Почему-то виснут обе команды.
Цитата:
Сообщение от VVA Посмотреть сообщение
Выложи или пришли пример, в котором виснет.
Обычный эллипс, начерченный когда-то от балды.
2018, Map/Civil, сохранен в 2004.
Вложения
Тип файла: dwg
DWG 2004
ellipse.dwg (379.7 Кб, 4 просмотров)
__________________
количество моих сообщений не говорит о знании Автокада
АлексЮстасу вне форума  
 
Непрочитано 29.06.2023, 18:29
1 | #31
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,981
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от АлексЮстасу Посмотреть сообщение
Обычный эллипс, начерченный когда-то от балды.
Я не могу повторить твой эллипс, но вижу что он есть.
Функция TraceAce считала, что начальный и конечный угол полного эллипса 0 - 360, но может быть и 90-90 как у тебя и 180-180 и 270-270. Из-за этого был бесконечный цикл. Поправил логику
обновил #8
Миниатюры
Нажмите на изображение для увеличения
Название: el.png
Просмотров: 12
Размер:	17.8 Кб
ID:	256975  
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 29.06.2023, 22:48
#32
АлексЮстасу

топограф, технолог
 
Блог
 
Регистрация: 24.05.2009
Москва
Сообщений: 3,041


Цитата:
Сообщение от VVA Посмотреть сообщение
Я не могу повторить твой эллипс, но вижу что он есть.
Я умудрился сваять какой-то неправильный эллипс?
Цитата:
Сообщение от VVA Посмотреть сообщение
Функция TraceAce считала, что начальный и конечный угол полного эллипса 0 - 360, но может быть и 90-90 как у тебя и 180-180 и 270-270. Из-за этого был бесконечный цикл. Поправил логику
обновил #8
Спасибо!
E2P теперь преобразует достаточно быстро и эллипсы, и эллиптические дуги.

О точности (вторая проблема - #20).
Пардон, если отморожу - я ничего не понимаю в коде, и математику не знал, но забыл.
Вижу в коде то
Код:
[Выделить все]
(equal (cdr(assoc 42 (entget el))) (* 2 pi) 1e-6)
, то
Код:
[Выделить все]
(equal endparam (* pi 2) 1e-12)
.
Может быть точность будет лучше, если "1e-6" заменить на "1e-8" или т.д.?
__________________
количество моих сообщений не говорит о знании Автокада
АлексЮстасу вне форума  
 
Непрочитано 30.06.2023, 08:58
1 | #33
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,981
<phrase 1= Отправить сообщение для VVA с помощью Skype™


можешь поправить и до 1e-6. Эти строки проверяют конечный угол и сравнивают его с 2*pi, т.е 360 градусов с точностью до 1e-x. Я обычно использую 1e-6, т.е до 0,000001. Автор этой функции использовал 1e-12, т.е. 0,000000000001. Но это сравнение с углом 360 градусов, поэтому можешь заменить и на 1e-8 или оставить как есть.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 30.06.2023, 18:43
#34
АлексЮстасу

топограф, технолог
 
Блог
 
Регистрация: 24.05.2009
Москва
Сообщений: 3,041


Цитата:
Сообщение от VVA Посмотреть сообщение
до 0,000001
Сейчас я намерил расхождения в 4-5 знаке.
Цитата:
Сообщение от VVA Посмотреть сообщение
твой эллипс
Возможно, этот эллипс был не непосредственно вручную начерчен. Кажется, я разбирался со штриховками, и этот эллипс мог получиться восстановлением границы штриховки.
__________________
количество моих сообщений не говорит о знании Автокада
АлексЮстасу вне форума  
 
Непрочитано 30.06.2023, 22:41
#35
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,981
<phrase 1= Отправить сообщение для VVA с помощью Skype™


АлексЮстасу, Мне тоже не получилось создать такой эллипс штатными средствами автокада, возможно он был создан программно каким-то приложением.
Цитата:
Сообщение от АлексЮстасу Посмотреть сообщение
Сейчас я намерил расхождения в 4-5 знаке.
Значит надо оставить 1e-3.
Цитата:
Сообщение от АлексЮстасу Посмотреть сообщение
О точности (вторая проблема - #20).
В функции TraceACE за количество полученных сегментов отвечает
Цитата:
anginc (* pi (/ 5.0 180.0))
, конкретнее цифра 5 (градусов). Т.е расчет точек идет через угловой инкремент, который равен 5 градусов, которые переводятся в радианы
Далее количество точек получается как разница между начальным и конечным углом эллипса (для полного эллипса 360 градусов или 2*pi радиан. Здесь и была ошибка для твоего эллипса)
Цитата:
;Divide delta (included angle) into an equal number of parts.
(setq div (1+ (fix (/ delta anginc)))
inc (/ delta div)
)
Попробуй поиграйся в строке
Цитата:
anginc (* pi (/ 5.0 180.0))
с цифрой 5 (замени на 3 или 2 или 1). Но это увеличит количество вершин

----- добавлено через ~5 мин. -----
Мне просто интересно, насколько критично для геодезии шаг в 5 градусов. Чтобы были большие расхождения, эллипсы должны быть больших размеров, а что может описываться эллипсом такого размера? Московская область, включая г.Москва?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 01.07.2023, 03:26
#36
АлексЮстасу

топограф, технолог
 
Блог
 
Регистрация: 24.05.2009
Москва
Сообщений: 3,041


Цитата:
Сообщение от VVA Посмотреть сообщение
не получилось создать такой эллипс штатными средствами автокада, возможно он был создан программно каким-то приложением.
Кажется, эллпис создан все же штатными автокадовскими средствами - могут ошибаться, программка восстанавливала границу штриховок командой HATCHEDIT.
Цитата:
Сообщение от VVA Посмотреть сообщение
Мне просто интересно, насколько критично для геодезии шаг в 5 градусов.
Я сейчас не про геодезию.
Смотрел программку, определяющую положение точек относительно контуров [штриховок]. Контуры делались полилиниями из эллипсов, окружностей, сплайнов и пр.
Тогда стали попадаться случаи, когда точки внутри или на границе определялись как внешние и наоборот. Оказалось, что дело в точности повторения этими полилиниями кривых.
Цитата:
Сообщение от VVA Посмотреть сообщение
Значит надо оставить 1e-3.
Я путаюсь - уменьшить с 6 до 3, разве не ухудшить точность?
__________________
количество моих сообщений не говорит о знании Автокада
АлексЮстасу вне форума  
 
Непрочитано 04.07.2023, 08:41
#37
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,981
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от АлексЮстасу Посмотреть сообщение
Я путаюсь - уменьшить с 6 до 3, разве не ухудшить точность?
Это сравнения угла эллипса с углом в 360 градусов, представленных в радианах, чтобы определить, это полный эллипс или эллиптическая дуга.
Сравнение до 1e-3=0,001 рад= 0.0572958 градуса или 0°3'26"
Т.е. если ты начертишь эллиптическую дугу в внутренним углом в 359°56'34", то сравнение до 1e-3 может посчитать это полным эллипсом и ты получишь замыкающий сегмент в виде полилинии
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 04.07.2023, 18:01
#38
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,651


VVA,
почему бы просто не проверить начальную и конечную точки?
Код:
[Выделить все]
 
(equal (vlax-get ellipse 'startpoint) (vlax-get ellipse  'endpoint))
__________________
K Lisp
koMon вне форума  
 
Непрочитано 05.07.2023, 13:33
#39
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,981
<phrase 1= Отправить сообщение для VVA с помощью Skype™


koMon, Да, так лучше. Обновил #8
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Convert ellipses to polylines

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск