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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > нарисовать полилинию из списка с координатами точек (lisp)

нарисовать полилинию из списка с координатами точек (lisp)

Ответ
Поиск в этой теме
Непрочитано 11.02.2011, 03:17 #1
нарисовать полилинию из списка с координатами точек (lisp)
paradoxvaha
 
проектирование противооползневых сооружений
 
Yalta
Регистрация: 06.04.2007
Сообщений: 50

Всем привет. Возник небольшой вопрос: можно ли как то нарисовать полилинию (_pline) по имеющимся координатам точек в списке lisp? Т.е. список состоит из точечных пар, и надо по этим точкам отрисовать полилинию. Если нет идей, то подскажите пожалуйста где об этом почитать можно.
Просмотров: 24538
 
Непрочитано 11.02.2011, 08:39
#2
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,702
Отправить сообщение для Do$ с помощью Skype™


Почему же нет идей, пожалуйста:
Код:
[Выделить все]
((lambda (lst)
   (vl-cmdf "_.pline")
   (foreach pt lst
     (vl-cmdf "_none" (list (car pt) (cdr pt)))
   ) ;_ end of foreach
   (vl-cmdf "_close")
 ) ;_ end of lambda
  '((0.0 . 0.0)
    (-100.0 . 100.0)
    (-100.0 . -100.0)
    (0.0 . 0.0)
    (100.0 . 100.0)
    (100.0 . -100.0)
   )
)
Do$ вне форума  
 
Непрочитано 11.02.2011, 10:34
2 | #3
VVA

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


Еще примеры
Код:
[Выделить все]
 
(defun ru-pline-entmake
			(points is_closed is_3d / elst ENTL)
;;; (ru-pline-entmake (список_вершин) флаг_замкнутости
;;; флаг_делать_3М_ПЛИНИЮ)
;;; возвращает имя примитива - полилинии или NIL, если что-то не
;;; вышло.
  ;|
Пример:
(ru-pline-entmake
(list
(list 220.65 345.001)
(list 332.622 546.525)
(list 846.376 320.906)
(list 719.035 121.572)
) T nil )
|;
  (if is_3d
    (progn
      (setq entl
	     (list
	       '(0 . "POLYLINE")
	       '(100 . "AcDbEntity")
	       '(100 . "AcDb3dPolyline")
	       '(66 . 1)
	       '(10 0.0 0.0 0.0)
	       (cons 70
		     (logior 8
			     (if is_closed
			       1
			       0
			     ) ;_ end of if
			     (if (= 1 (getvar "PLINEGEN"))
			       128
			       0
			     ) ;_ end of if
		     ) ;_ end of logior
	       ) ;_ end of cons
	     ) ;_ end of list
      ) ;_ end of setq
      (if (entmake entl)
	(progn
	  (foreach v points
	    (progn
	      (setq entl
		     (list
		       '(0 . "VERTEX")
		       '(100 . "AcDbEntity")
		       '(100 . "AcDbVertex")
		       '(100 . "AcDb3dPolylineVertex")
		       (append '(10) v)
		       '(70 . 32)
		     ) ;_ end of list
	      ) ;_ end of setq
	      (entmake entl)
	    ) ;_ end of progn
	  ) ;_ end of foreach
	  (if (entmake '((0 . "SEQEND") (100 . "AcDbEntity")))
	    (entupd (entlast))
	    nil
	  ) ;_ end of if
	) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
    (progn
      (setq elst (append
		   (list
		     '(0 . "LWPOLYLINE")
		     '(100 . "AcDbEntity")
		     '(100 . "AcDbPolyline")
					;(cons 8 (getvar "CLAYER"))
		     (cons 90 (length points))
		     (cons 70
			   (logior (if is_closed
				     1
				     0
				   ) ;_ end of if
				   (if (= 1 (getvar "PLINEGEN"))
				     128
				     0
				   ) ;_ end of if
			   ) ;_ end of logand
		     )			; _ end of cons;;;
		   ) ;_ end of list
		   (mapcar '(lambda (p)
			      (list 10 (car p) (cadr p))
			    ) ;_ end of lambda
			   points
		   ) ;_ end of mapcar
		 ) ;_ end of append
      ) ;_ end of setq
      (if (entmake elst)
	(entupd (entlast))
	nil
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun
Только lw полилиния
Код:
[Выделить все]
 
(defun LWPoly (lst cls / exv)
; Draw lwpolyline in current UCS
; version for pre-visual lisp.
; lst - list of points ((X1 Y1)(X2 Y2) ... (Xn Yn)) in current UCS
; cls - DXF group 70 flag  to indicate closure : 0 = open, 1 = closed 
  (setq exv (trans (list 0 0 1) 1 0 T)) 
  (entmakex (append (list (cons 0 "LWPOLYLINE") 
                          (cons 38 (caddr (trans (car lst) 1 exv))) 
                          (cons 100 "AcDbEntity") 
                          (cons 100 "AcDbPolyline") 
                          (cons 90 (length lst)) 
                          (cons 70 cls) 
                          (cons 210 exv)) 
                    (mapcar '(lambda (p) (cons 10 (trans p 1 exv))) lst))) 
)				 
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 11.02.2011, 12:59
#4
paradoxvaha

проектирование противооползневых сооружений
 
Регистрация: 06.04.2007
Yalta
Сообщений: 50
<phrase 1=


Цитата:
Сообщение от Do$ Посмотреть сообщение
Почему же нет идей, пожалуйста:
Код:
[Выделить все]
((lambda (lst)
   (vl-cmdf "_.pline")
   (foreach pt lst
     (vl-cmdf "_none" (list (car pt) (cdr pt)))
   ) ;_ end of foreach
   (vl-cmdf "_close")
 ) ;_ end of lambda
  '((0.0 . 0.0)
    (-100.0 . 100.0)
    (-100.0 . -100.0)
    (0.0 . 0.0)
    (100.0 . 100.0)
    (100.0 . -100.0)
   )
)
Вот этот код - то что надо, но у меня не получается свой список в него вписать. У меня просто уже создан список (присвоен переменной), а как его применить относительно этого кода - непонятно. Список состоит из точечных пар, то есть первый элемент списка выглядет примерно так: (18820.53521278781,12841.22697685545) и таких элементов в списке от 20ти до 50ти. Можно ли его как то привязать к вышеуказанному коду?

PS VVA за код с созданием объекта - спасибо, но это для моего понимания слишком сложно, а то что я не понимаю, стараюсь не использовать.
paradoxvaha вне форума  
 
Непрочитано 11.02.2011, 13:12
#5
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,702
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от paradoxvaha Посмотреть сообщение
(18820.53521278781,12841.22697685545)
Это не точечная пара, а непонятно что
Вот это точечная пара:
Код:
[Выделить все]
'(18820.53521278781 . 12841.22697685545)
А список как выгдядит?
Do$ вне форума  
 
Непрочитано 11.02.2011, 13:38
#6
VVA

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


Цитата:
Сообщение от Do$ Посмотреть сообщение
но это для моего понимания слишком сложно
А понимать не обязательно, можно просто использовать
Код:
[Выделить все]
 
;;;Создаем список
(setq lst (list
            (list 18820.53521278781 12841.22697685545)
            (list 18830.3 12834.2)
            (list 18860.52 12827.69)
            )
      )
;;Используем готовую функцию
(LWPoly
  lst ;_Передаем предварительно сформированный список
  0   ;_ Незамкнутая полилиния
  )
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 11.02.2011, 18:57
#7
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,515


Ну и до кучи:
Код:
[Выделить все]
 (setq *cdl_actvdoc* (vla-get-ActiveDocument (vlax-get-acad-object))
(defun cdx-AddLightWeightPolyline (lst / templst)
;;; Добавляет 3М полилнию
;;;(cdx-AddLightWeightPolyline (list '(0 0) '(100 200) '(300 300 300)))
  (vla-AddLightWeightPolyline
	(vla-get-Block (vla-get-ActiveLayout *cdl_actvdoc*))
	(vlax-safearray-fill
	  (vlax-make-safearray
		vlax-vbDouble
		(vl-list* 0 (1- (length (setq templst
		  (apply 'append (mapcar (function
			(lambda (x)
			  (cond
				((= 3 (length x)) (reverse (cdr (reverse x))))
				(T x))))
			  lst)))))))
	  templst
	)
  )
)

(defun cdx-AddPolyline (lst / templst)
;;; Добавляет 3М полилнию
;;;(cdx-AddPolyline (list '(0 0) '(100 200) '(300 300 300)))
  (vla-AddPolyline
	(vla-get-Block (vla-get-ActiveLayout *cdl_actvdoc*))
	(vlax-safearray-fill
	  (vlax-make-safearray
		vlax-vbDouble
		(vl-list* 0 (1- (length (setq templst
		  (apply 'append (mapcar (function
			(lambda (x)
			  (cond
				((= 2 (length x)) (list (car x) (cadr x) 0.0))
				(T x))))
			  lst)))))))
	  templst
	)
  )
)

(defun cdx-Add3DPoly (lst / templst)
;;; Добавляет 3М полилнию
;;;(cdx-Add3DPoly (list '(0 0) '(100 200) '(300 300 300)))
  (vla-Add3DPoly
	(vla-get-Block (vla-get-ActiveLayout *cdl_actvdoc*))
	(vlax-safearray-fill
	  (vlax-make-safearray
		vlax-vbDouble
		(vl-list* 0 (1- (length (setq templst
		  (apply 'append (mapcar (function
			(lambda (x)
			  (cond
				((= 2 (length x)) (list (car x) (cadr x) 0.0))
				(T x))))
			  lst)))))))
	  templst
	)
  )
)
gomer вне форума  
 
Непрочитано 11.02.2011, 19:04
#8
Александр Ривилис

программист, рыцарь ObjectARX
 
Регистрация: 09.05.2005
Киев
Сообщений: 2,405
Отправить сообщение для Александр Ривилис с помощью Skype™


gomer А комментарии неправильные - создаются три типа полилиний, а в комментариях везде "Добавляет 3М полилнию" (про опечатку я молчу).
Александр Ривилис вне форума  
 
Непрочитано 11.02.2011, 19:07
#9
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,439
Отправить сообщение для Елпанов Евгений с помощью Skype™


до кучи, так до кучи...
Код:
[Выделить все]
 (ACET-PLINE-MAKE '(((0. 0. 0.) (10. 0. 0.) (10. 10. 0.) (0. 10. 0.) (0. 0. 0.))
                   (0.0 0.0 0.0 0.0)
                   (0.0 0.0 0.0 0.0)
                   (0.0 0.0 0.0 0.0)
                  )
)
__________________
Чем гениальнее ваш план, тем меньше людей с ним будут согласны.
/Сунь Цзы/
Елпанов Евгений вне форума  
 
Непрочитано 11.02.2011, 19:18
#10
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,515


Александр Ривилис, именно такой реакции я и ожидал... спасибо, надеюсь сам код рабочий... ибо сам его основательно не тестил...
gomer вне форума  
 
Автор темы   Непрочитано 11.02.2011, 22:30
#11
paradoxvaha

проектирование противооползневых сооружений
 
Регистрация: 06.04.2007
Yalta
Сообщений: 50
<phrase 1=


Цитата:
Сообщение от VVA Посмотреть сообщение
Только lw полилиния
Код:

view source
print?
01 (defun LWPoly (lst cls / exv)
02 ; Draw lwpolyline in current UCS
03 ; version for pre-visual lisp.
04 ; lst - list of points ((X1 Y1)(X2 Y2) ... (Xn Yn)) in current UCS
05 ; cls - DXF group 70 flag to indicate closure : 0 = open, 1 = closed
06 (setq exv (trans (list 0 0 1) 1 0 T))
07 (entmakex (append (list (cons 0 "LWPOLYLINE")
08 (cons 38 (caddr (trans (car lst) 1 exv)))
09 (cons 100 "AcDbEntity")
10 (cons 100 "AcDbPolyline")
11 (cons 90 (length lst))
12 (cons 70 cls)
13 (cons 210 exv))
14 (mapcar '(lambda (p) (cons 10 (trans p 1 exv))) lst)))
15 )

__________________
Всем огромное спасибо за советы! По предложению VVA не стал вдаваться в подробности, а просто использовал его код, все отлично работает, как мне и нужно! Еще раз спасибо всем!
paradoxvaha вне форума  
 
Непрочитано 12.02.2011, 06:31
#12
Disney

Геодезист
 
Регистрация: 12.03.2009
Сибирь (где медведи по улицам ходят)
Сообщений: 860
Отправить сообщение для Disney с помощью Skype™


Цитата:
Сообщение от Елпанов Евгений Посмотреть сообщение
ACET-PLINE-MAKE
опа... а что это за функция такая, а то я её описание ни где не нашёл, ни в тырнете, ни у Полещука, не то чтобы сама функция была мне интересна, я пользуюсь ru-pline-entmake в общих случаях и тупо (entmake) в частных.
Может там ещё много чего интересного в ACET-ах есть?
__________________
Почему все вдруг становятся умными, когда уже не надо?
Disney вне форума  
 
Непрочитано 12.02.2011, 11:25
#13
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,515


Цитата:
Сообщение от Disney Посмотреть сообщение
Может там ещё много чего интересного в ACET-ах есть?
Есть
Мне вот интересно:
ну, ладно, командный метод - самый простой, но грязный и медленный
насколько быстрее vla-AddPolyline, чем entmake
gomer вне форума  
 
Непрочитано 12.02.2011, 16:36
#14
ShaggyDoc

Thượng Tá Quân Đội Nhân Dân Việt Nam
 
Регистрация: 14.03.2005
44d32'44"С, 33d26'51"В
Сообщений: 13,381


Цитата:
ну, ладно, командный метод - самый простой, но грязный и медленный
насколько быстрее vla-AddPolyline, чем entmake
В AutoCAD есть тестовые файлы
Sample\VisualLISP\activex\al-tst.lsp
Sample\VisualLISP\activex\vla-tst.lsp
Sample\VisualLISP\activex\vla-tst.prj

Каждый может попробовать. Можно и ent-функции проверить. Можно и в компилированном виде.

Я когда-то проверял. . Эти программы выполняют одинаковую работу (рисуют 2000 полилиний, изменяют их цвет и удаляют), но разными методами, с фиксацией затраченного времени.

AL-TST использует функции command и entmod, а VLA-TST — функции ActiveX. Результаты (конечно, разные на различных компьютерах) показывают, что функции ActiveX работают значительно быстрее. На очень "слабом" компьютере, специально используемом нами для тестирования, получены результаты:

AL-TST — 206.8 сек (13.141 сек на "хорошем" компьютере)
VLA-TST — 143.79 сек. (5.61 сек на "хорошем" компьютере)

При замене в al.lsp (command "_.PLINE"…) на (entmake…) получаем результаты:

AL-TST — 115.95 сек (6.812 сек на "хорошем" компьютере)

Естественно, что вариант с функцией command показывает худшие результаты. Иного и не могло быть, так как AutoCAD должен анализировать (неизвестный заранее) поток данных, передаваемый в виде аргументов функции. При использовании функции entmake передаются уже известные структуры данных, близкие к внутреннему представлению, и процесс идет гораздо быстрее.

При использовании объектной модели данные передаются в виде уже совсем близком к внутреннему представлению (через Visual LISP) и в "готовом к употреблению" виде при использовании VBA. Некоторое замедление дает цепочка посредников при передаче данных через интерфейсы различных объектов. Именно это дает действительное или кажущееся отставание.

На высокопроизводительных машинах накладные расходы будут менее заметны. В использование ActiveX дает выигрыш в производительности.

Ну, и если уж стали демонстрировать разные коды, показывают тот, который всегда использую:
Код:
[Выделить все]
 

(defun ru-pline-add (points is_closed width lineweight ltype / obj)
                    ;|
(ru-pline-add (list (list 0 0) (list 10000 1000) (list 10000 20000) (list 0 20000)) nil  0 50 "HIDDEN")

|;
  (ru-error-catch
    (function
      (lambda ()
        (setq
          obj (vla-addlightweightpolyline
                (ru-obj-active-space)
                (ru-conv-list-points-to-variant-array
                  (apply
                    'append
                    (mapcar 'ru-conv-3dpoint-to-2dpoint
                            points
                    ) ;_ end of mapcar
                  ) ;_ end of apply
                ) ;_ end of ru-conv-list-points-to-variant-array
              ) ;_ end of vla-addlightweightpolyline
        ) ;_ end of setq
        (cond
          ((and
             (vlax-read-enabled-p obj)
             (vlax-write-enabled-p obj)
           ) ;_ end of and
           (if is_closed
             (vla-put-closed obj :vlax-true)
           ) ;_ end of if
           (if width
             (vla-put-constantwidth obj width)
           ) ;_ end of if
           (ru-lw-set-for-obj obj lineweight)
           (if Ltype
             (ru-ltype-apply obj Ltype)
           ) ;_ end of if
           (vla-update obj)
           obj
          )
        ) ;_ end of cond
      ) ;_ end of lambda
    ) ;_ end of function
    (function (lambda (x)
                (princ (strcat "\nОШИБКА RU-PLINE-ADD " x))
                nil
              ) ;_ end of lambda
    ) ;_ end of function
  ) ;_ end of ru-error-catch                
) ;_ end of defun
Здесь могут быть переданы дополнительные аргументы is_closed width lineweight ltype и есть ловушка ошибок.

Есть и аналогичная (ru-3d-pline-add points is_closed lineweight ltype). Отличается только использованием vla-add3dpoly

Последний раз редактировалось ShaggyDoc, 12.02.2011 в 16:45.
ShaggyDoc вне форума  
 
Непрочитано 12.02.2011, 16:54
#15
Disney

Геодезист
 
Регистрация: 12.03.2009
Сибирь (где медведи по улицам ходят)
Сообщений: 860
Отправить сообщение для Disney с помощью Skype™


Цитата:
Сообщение от gomer Посмотреть сообщение
Мне вот интересно:
ну, ладно, командный метод - самый простой, но грязный и медленный
насколько быстрее vla-AddPolyline, чем entmake
Код:
[Выделить все]
 (defun LWPoly (lst cls / exv)
	      ;|
Draw lwpolyline in current UCS
version for pre-visual lisp.
lst - list of points ((X1 Y1)(X2 Y2) ... (Xn Yn)) in current UCS
cls - DXF group 70 flag  to indicate closure : nil = open, T = closed
|;
  (setq exv (trans (list 0 0 1) 1 0 T))
  (entmakex
    (append (list (cons 0 "LWPOLYLINE")
		  (cons 38 (caddr (trans (car lst) 1 exv)))
		  (cons 100 "AcDbEntity")
		  (cons 100 "AcDbPolyline")
		  (cons 90 (length lst))
		  (cons	70
			(if cls
			  1
			  0
			)
		  )
		  (cons 210 exv)
	    )
	    (mapcar '(lambda (p) (cons 10 (trans p 1 exv))) lst)
    )
  )
)


(defun cdx-AddLightWeightPolyline (lst cls / templst temp)
;;; Добавляет LW полилнию
;;;(cdx-AddLightWeightPolyline (list '(0 0) '(100 200) '(300 300 300)) t)
  (vl-load-com) 
  (setq	temp
	 (vla-AddLightWeightPolyline
	   (vla-get-Block (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object))))
	   (vlax-safearray-fill
	     (vlax-make-safearray
	       vlax-vbDouble
	       (vl-list* 0
			 (1- (length (setq templst
					    (apply 'append
						   (mapcar (function
							     (lambda (x)
							       (cond
								 ((= 3 (length x))
								  (reverse (cdr (reverse x)))
								 )
								 (T x)
							       )
							     )
							   )
							   lst
						   )
					    )
				     )
			     )
			 )
	       )
	     )
	     templst
	   )
	 )
  )
  (if cls
    (vla-put-Closed
      temp
      :vlax-true
    )
  )

)
Код:
[Выделить все]
Команда: (setq list_ '((0 0)(0 10)(10 10)(10 0)))
((0 0) (0 10) (10 10) (10 0))

Команда: (benchmark '((cdx-AddLightWeightPolyline list_ t)(LWPoly list_ t)))
Elapsed milliseconds / relative speed for 8192 iteration(s):

    (LWPOLY LIST_ T).........................1310 / 2.54 <fastest>
    (CDX-ADDLIGHTWEIGHTPOLYLINE LIST_ T).....3323 / 1.00 <slowest>

Команда: (benchmark '((cdx-AddLightWeightPolyline list_ nil)(LWPoly list_ nil)))
Elapsed milliseconds / relative speed for 8192 iteration(s):

    (LWPOLY LIST_ nil).........................1295 / 2.63 <fastest>
    (CDX-ADDLIGHTWEIGHTPOLYLINE LIST_ nil).....3401 / 1.00 <slowest>
__________________
Почему все вдруг становятся умными, когда уже не надо?
Disney вне форума  
 
Непрочитано 12.02.2011, 17:30
#16
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,515


ну и кому верить?
gomer вне форума  
 
Непрочитано 12.02.2011, 23:19
#17
Кулик Алексей aka kpblc
Moderator

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


Ну, чтобы окончательно запутать ситуацию, можно еще посмотреть http://autolisp.ru/2009/09/22/programming-style/ - я там тоже некоторые "исследования" проводил
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 13.02.2011, 00:50
#18
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,515


Вот еще интересно как влияет на быстродействие версия када на одной системе...
Попробовал вот такую функцию, найденную в инете, на звкаде, впал в уныние... entmake в несколько раз быстрее, чем vla-
Код:
[Выделить все]
 ;; SIERPINS.LSP для XLISP версии 2.1
;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;; Программа построения кривых Серпинского i-го порядка.
;;
;; ЗАПУСК:  > (SierpinskiCurve 4)
;;
;; Замечание: Переменная *VMode* управляет установкой видео режима,
;;            и по умолчанию установлена в значение 18.
;;            Эта установка соответствует режиму 640x480 Color,
;;            и работает на большинстве систем. В случае проблемы
;;            с установкой этого режима необходимо выбрать
;;            значение этой переменной в соответствии с документацией
;;            на оборудование.
;;

;( defvar *VMode* 18 )       ;Видео режим по умолчанию
;( defvar *MaxX* 640 )       ;Максимальная ширина экрана по умолчанию
;( defvar *MaxY* 480 )       ;Максимальная высота экрана по умолчанию
;( defvar *SquareSize* 256 ) ;Размер области для построения

;;
;; Функция инициализирует графический режим, устанавливает переменные
;; *MaxX* *MaxY* *SquareSize* в соответствии с выбранным режимом
;;
(defun InitGraph()
   (
     case *VMode*
       ( 4                        ;320x200 Color
       ( mode 4 )
       ( setq *MaxX* 320 *MaxY* 200 *SquareSize* 128 ) )
       ( 16                       ;640x350 Color
       ( mode 16 )
       ( setq *MaxX* 640 *MaxY* 350 *SquareSize* 128 ) )
       ( 18                       ;640x480 Color
       ( mode 18 ) )
       ( 106                      ;800x600 Color
       ( mode 106 106 800 600 )
       ( setq *MaxX* 800 *MaxY* 600 *SquareSize* 512 ) )
       ( t ( error Unsupported graphics mode:  *VMode* ) )
    )
)

;;
;; Функция реализует задержку на заданное время
;;
(
 defun pause ( time )
  (princ)
   ;( let ( ( fintime ( + ( * time internal-time-units-per-second )
   ;                      ( get-internal-run-time ) ) ) )
   ;( loop ( when ( > ( get-internal-run-time) fintime )
   ;                  ( return-from pause ) ) ) )
)

;;
;; Функция целочисленного деления
;;
(defun div (a b / )(fix( / a b )))


;;
;; Функция рисования прямой:
;; Параметры:  - направление рисования (0-7)
;;             - длинна прямой
;;
(defun Line(Direction Size)
   (setq x Px y Py )
  (cond
    ((= 0 Direction)(setq x(+ x Size)))
    ((= 1 Direction)(setq x(+ x Size )y(- y Size)))
    ((= 2 Direction)(setq y(- y Size)))
    ((= 3 Direction)(setq x(- x Size)y(- y Size )))
    ((= 4 Direction)(setq x(- x Size)))
    ((= 5 Direction)(setq x(- x Size )y(+ y Size)))
    ((= 6 Direction)(setq y(+ y Size)))
    ((= 7 Direction)(setq x(+ x Size )y(+ y Size)))
  )
  (if T
    (vla-addLine
      (vla-get-Block (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object))))
      (vlax-3d-point (list px py 0))
      (vlax-3d-point (list x y 0))
    )
    (entmake (list (cons 0 "LINE") (cons 10 (list px py)) (cons 11 (list x y))))
  )
  (setq Px x Py y ) 
)


;;
;; Функции A, B, C, D - рекурсивные функции рисования
;;
(defun A ( k )
   ( cond ( ( > k 0 )
           ( A ( - k 1 ) )  ( Line 1 h )
           ( B ( - k 1 ) )  ( Line 0 ( * 2 h ) )
           ( D ( - k 1 ) )  ( Line 7 h )
           ( A ( - k 1 ) )
   ) )
)

(defun B ( k )
   ( cond ( ( > k 0 )
           ( B ( - k 1 ) )  ( Line 3 h )
           ( C ( - k 1 ) )  ( Line 2 ( * 2 h ) )
           ( A ( - k 1 ) )  ( Line 1 h )
           ( B ( - k 1 ) )
   ) )
)

(defun C ( k )
   (cond ( ( > k 0 )
           ( C ( - k 1 ) )  ( Line 5 h )
           ( D ( - k 1 ) )  ( Line 4 ( * 2 h ) )
           ( B ( - k 1 ) )  ( Line 3 h )
           ( C ( - k 1 ) )
   ) )
)

(
 defun D ( k )
   ( cond ( ( > k 0 )
           ( D ( - k 1 ) )  ( Line 7 h )
           ( A ( - k 1 ) )  ( Line 6 ( * 2 h ) )
           ( C ( - k 1 ) )  ( Line 5 h )
           ( D ( - k 1 ) )
   ) )
)


(defun SierpinskiCurve ( Count )

   ;( InitGraph ) ;Установка графического режима
    ( setq *SquareSize* 512)
    ( setq *MaxX* 800)
    ( setq *MaxY* 600)
    ( setq h ( div *SquareSize* 4 ) )     ;Вычисление длины линии
   
    ( setq x0 ( div *MaxX* 2 ) )           ;Вычисление начальной точки
    ( setq y0 ( div *MaxY* 2 ) )
    ( setq i 1)                    ;для рисования

   (while (<= i Count)                                     ;Основной цикл
                            ;Инициализация счетчика

          ;Условие завершения

          ( setq x0 ( - x0 h ) )          ;Вычисление координат начальной
          ( setq h ( div h 2 ) )          ;точки для рисования и
          ( setq y0 ( + y0 h ) )          ;единичной длины линии

          ( setq Px x0 Py y0 )            ;Установка пера

          (setvar "cecolor" (itoa i))                     ;Установка цвета для рисования

          ( A i ) ( Line 1 h )            ;Рисование
          ( B i ) ( Line 3 h )
          ( C i ) ( Line 5 h )
          ( D i ) ( Line 7 h )

          ;( pause 1.0 )                   ;Задержка
          (setq i (1+ i))             ;Инкримент счетчика

   )                                      ;Конец основного цикла
)
Получается что:
Цитата:
The newest way of creating entities is by using the ActiveX functions within VLISP. ActiveX has several advantages over entmake and command.
  • ActiveX functions are faster.
  • ActiveX function names indicate the action they perform, resulting in easier readability, maintenance, and bug-fixing.
Не совсем правда, мягко говоря...

Последний раз редактировалось gomer, 13.02.2011 в 00:57.
gomer вне форума  
 
Непрочитано 13.02.2011, 06:45
#19
ShaggyDoc

Thượng Tá Quân Đội Nhân Dân Việt Nam
 
Регистрация: 14.03.2005
44d32'44"С, 33d26'51"В
Сообщений: 13,381


Так многое зависит от методики и от правильности самой тестовой программы. Например, если в цикле делается несколько вызовов

Код:
[Выделить все]
 (setq x0 ( - x0 h ))          
(setq h ( div h 2 ))
(setq y0 ( + y0 h ))
(setq Px x0 Py y0) 
вместо
Код:
[Выделить все]
 (setq x0 ( - x0 h )          
        h ( div h 2 )
        y0 ( + y0 h )
       Px x0 Py y0) 
это уже замедляет работу, независимо от метода рисования, но может дать разное соотношение "накладных расходов".

А зачем, например, vla-get-Block вставлен? Конечно, такой вызов будет работать медленнее, чем простенький entmake.

Ну и вообще тесты делаются, чтобы доказать желаемый для себя результат, а не найти истину.
ShaggyDoc вне форума  
 
Непрочитано 13.02.2011, 09:57
#20
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,439
Отправить сообщение для Елпанов Евгений с помощью Skype™


В свое время, я так же делал обширные тесты по быстродействию различных методов. Результаты были еще интереснее, некоторые методы быстрее через vla, а некоторые через entmak, entmod... Т.е нет идеального выбора. В своей практике, я пошел по упрощенному пути выбора - если необходимо просто создать объект, без изменений свойств, например линию в текущем слое, текущего цвета итд, то я частенько использую vla-add*, если же необходимо еще и добавить новый слой и в него вставить линию, изменить цвет, тип линии - я уже иду через entmakex - так быстрее, короче по коду и нагляднее в программе.
Самый наглядный пример, это серия функций vlax-curve*. В справке написано, что они работают только с vla объектами, но это не правда! В эти функции можно передавать ename представление элементов. Самое интересное, что если передавать именно ename, то скорость вырастает в разы...
Мой совет, хотите найти самый быстрый путь - все проверяйте. Нет однозначного ответа на этот вопрос.
ps. Я выбрал мешанину из обоих путей, т.е в одной программе, у меня используются оба метода.
__________________
Чем гениальнее ваш план, тем меньше людей с ним будут согласны.
/Сунь Цзы/
Елпанов Евгений вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > нарисовать полилинию из списка с координатами точек (lisp)

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP - 2D полилинию в 3D Andrej LISP 22 25.04.2019 11:40
Как с помощью LISP нарисовать окно линиями? Aндрeй LISP 13 24.06.2011 14:37
Как имея массив точек создать полилинию по ним? emilko AutoCAD 9 19.06.2009 23:15
Lisp: Обработка объектов и получение списка свойств (координаты точек) Nanotronic LISP 2 23.04.2009 23:07
нарисовать полилинию и запустить макрос VBA gizmo_zx Программирование 8 24.12.2008 08:47