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

paradoxvaha · 11.02.2011, 03:17

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

Do$ · 11.02.2011, 08:39

Почему же нет идей, пожалуйста:

Код:

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

((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)
   )
)

VVA · 11.02.2011, 10:34

Еще примеры

Код:

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

 
(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))) 
)

paradoxvaha · 11.02.2011, 12:59

Цитата:

Сообщение от 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 за код с созданием объекта - спасибо, но это для моего понимания слишком сложно, а то что я не понимаю, стараюсь не использовать.

Do$ · 11.02.2011, 13:12

Цитата:

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

(18820.53521278781,12841.22697685545)

Это не точечная пара, а непонятно что

Вот это точечная пара:

Код:

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

'(18820.53521278781 . 12841.22697685545)

А список как выгдядит?

VVA · 11.02.2011, 13:38

Цитата:

Сообщение от Do$

но это для моего понимания слишком сложно

А понимать не обязательно, можно просто использовать

Код:

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

 
;;;Создаем список
(setq lst (list
            (list 18820.53521278781 12841.22697685545)
            (list 18830.3 12834.2)
            (list 18860.52 12827.69)
            )
      )
;;Используем готовую функцию
(LWPoly
  lst ;_Передаем предварительно сформированный список
  0   ;_ Незамкнутая полилиния
  )

gomer · 11.02.2011, 18:57

Ну и до кучи:

Код:

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

 (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
	)
  )
)

Александр Ривилис · 11.02.2011, 19:04

gomer А комментарии неправильные - создаются три типа полилиний, а в комментариях везде "Добавляет 3М полилнию" (про опечатку я молчу).

Елпанов Евгений · 11.02.2011, 19:07

до кучи, так до кучи...

Код:

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

 (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)
                  )
)

gomer · 11.02.2011, 19:18

Александр Ривилис, именно такой реакции я и ожидал... спасибо, надеюсь сам код рабочий... ибо сам его основательно не тестил...

paradoxvaha · 11.02.2011, 22:30

Цитата:

Сообщение от 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 не стал вдаваться в подробности, а просто использовал его код, все отлично работает, как мне и нужно! Еще раз спасибо всем!

Disney · 12.02.2011, 06:31

Цитата:

Сообщение от Елпанов Евгений

ACET-PLINE-MAKE

опа... а что это за функция такая, а то я её описание ни где не нашёл, ни в тырнете, ни у Полещука, не то чтобы сама функция была мне интересна, я пользуюсь ru-pline-entmake в общих случаях и тупо (entmake) в частных.
Может там ещё много чего интересного в ACET-ах есть?

gomer · 12.02.2011, 11:25

Цитата:

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

Может там ещё много чего интересного в ACET-ах есть?

Есть

Мне вот интересно:
ну, ладно, командный метод - самый простой, но грязный и медленный
насколько быстрее vla-AddPolyline, чем entmake

ShaggyDoc · 12.02.2011, 16:36

Цитата:

ну, ладно, командный метод - самый простой, но грязный и медленный
насколько быстрее 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

Disney · 12.02.2011, 16:54

Цитата:

Сообщение от 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>

gomer · 12.02.2011, 17:30

ну и кому верить?

Кулик Алексей aka kpblc · 12.02.2011, 23:19

Ну, чтобы окончательно запутать ситуацию, можно еще посмотреть http://autolisp.ru/2009/09/22/programming-style/ - я там тоже некоторые "исследования" проводил

gomer · 13.02.2011, 00:50

Вот еще интересно как влияет на быстродействие версия када на одной системе...
Попробовал вот такую функцию, найденную в инете, на звкаде, впал в уныние... 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.

Не совсем правда, мягко говоря...

ShaggyDoc · 13.02.2011, 06:45

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

Код:

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

 (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.

Ну и вообще тесты делаются, чтобы доказать желаемый для себя результат, а не найти истину.

Елпанов Евгений · 13.02.2011, 09:57

В свое время, я так же делал обширные тесты по быстродействию различных методов. Результаты были еще интереснее, некоторые методы быстрее через vla, а некоторые через entmak, entmod... Т.е нет идеального выбора. В своей практике, я пошел по упрощенному пути выбора - если необходимо просто создать объект, без изменений свойств, например линию в текущем слое, текущего цвета итд, то я частенько использую vla-add*, если же необходимо еще и добавить новый слой и в него вставить линию, изменить цвет, тип линии - я уже иду через entmakex - так быстрее, короче по коду и нагляднее в программе.
Самый наглядный пример, это серия функций vlax-curve*. В справке написано, что они работают только с vla объектами, но это не правда! В эти функции можно передавать ename представление элементов. Самое интересное, что если передавать именно ename, то скорость вырастает в разы...
Мой совет, хотите найти самый быстрый путь - все проверяйте. Нет однозначного ответа на этот вопрос.
ps. Я выбрал мешанину из обоих путей, т.е в одной программе, у меня используются оба метода.

Disney · 13.02.2011, 10:02

Цитата:

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

А зачем, например, vla-get-Block вставлен?

А затем, чтоб полилиния создавалась в активном пространстве, так же как это будет при entmake
заменив

Код:

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

 (vla-get-Block (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object))))

на

Код:

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

 (if (= 1 (getvar "TILEMODE")) 
     (vla-get-ModelSpace(vla-get-ActiveDocument(vlax-get-Acad-Object))) 
     (vla-get-PaperSpace(vla-get-ActiveDocument(vlax-get-Acad-Object))) 
   )

Легче стало не намного, соотношение времени выполнения vla : ent стало 2.3 : 1, вместо 2.5 : 1 ранее

Цитата:

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

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

И entmake не простенький, там ещё tranc-иться всё постоянно, чтоб сравниваемые функции были идентичными.

Li6-D · 13.02.2011, 12:01

Самое простое, что можно предложить автору темы:

Код:

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

;|Выражение для рисования незамкнутой lw-полилинии нулевой толщины "командным" методом.
Если заменить '("") на '("_Close") получится замкнутая полилиния.
Точки полилинии должны быть определены в списке pN.|;
(apply 'vl-cmdf (append (list "_.PLINE" (car pN) "_W" 0 0) (cdr pN) '("")))

Интересно насколько оно медленнее по сравнению с vla-,ent-методами?

Код:

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

;;Выражение, формирующее список точек pN для тестирования.
;;Последовательность ввода точек обозначается временными векторами красного цвета.
((lambda (p)
   (setq PN nil)
   (if p
     (while (setq pN (cons p pN) p (getpoint p "\nВведите следующую точку: "))
       (grdraw (car pN) p 1)
   ) )
   (setq PN (reverse pN))
 )
 (getpoint "\nВведите первую точку: ")
)

SteelBrother · 14.04.2012, 18:24

VVA
Подскажи пожалуйста, зачем в посте номер 3 вы использовали функцию trans? полдня голову ломаю)))
одно предположение есть только: для того что бы избавится от проблем если в системе переменная ELEVATION отлична от нуля.

Александр Ривилис · 14.04.2012, 18:29

В ту функцию точки передаются в текущей UCS.

SteelBrother · 14.04.2012, 18:40

уточню. в текущей? или в МСК?

Александр Ривилис · 14.04.2012, 18:49

Цитата:

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

; lst - list of points ((X1 Y1)(X2 Y2) ... (Xn Yn)) in current UCS

UCS - это ПСК. WCS - это МСК. Данная функция считает, что точки передаются ей в текущей ПСК (current UCS)

SteelBrother · 14.04.2012, 18:56

спасибо. понял.

Eghor123 · 19.02.2014, 21:13

Цитата:

Сообщение от Елпанов Евгений

ACET-PLINE-MAKE

а что это вообще за функции такие? чет мне про них ничего не известно

Кулик Алексей aka kpblc · 19.02.2014, 21:39

Из ExpressTools

alex101000 · 25.12.2014, 17:49

Подскажите, пожалуйста, как изменить только одну из координат точки в http://forum.dwg.ru/showpost.php?p=700954&postcount=22 ? Значение поправки должно запрашиваться для каждого участка полилинии.

alex101000 · 30.12.2014, 13:05

Голова поломалась. Запутался в строке вусмерть.

Код:

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

 (while (setq pN (cons p pN) p (getpoint p "\nВведите следующую точку: "))

Уже на (getpoint p "\nВведите...") торможу, ведь обычно запись вида (setq p (getpoint "\nВведите...")).
Дальше вообще запутался: аргументы (setq pN) какие ? (cons p pN) ? А что тогда (setq pN (cons p pN) p вот это ?

VVA · 30.12.2014, 14:22

Цитата:

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

(setq pN (cons p pN) p вот это ?

Это СПИСОК точек

Цитата:

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

Уже на (getpoint p "\nВведите...") торможу, ведь обычно запись вида (setq p (getpoint "\nВведите...")).

Это необязательный параметр, нужен для отображения резиновой линии.
Если раздражает, можно и убрать

alex101000 · 13.01.2015, 15:00

VVA, благодарю за разъяснение. Резиновая линия на этапе отладки даже помогает.
Из палок и глины получилось вот что:

Код:

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

 
(defun change_point (point / dx dy new_point)
 ;точка
 ;смещение по х
 ;смещение по y
 ;измененная точка
					
 (setq dx 0)
 ;;изменение координаты х
  (setq   new_point
    (subst                         ;заменить
      (+ (car point) dx)      ;на новую x
      (car point)         ;старую x
      point         ;в координатах точки point
    )            ;end subst
  )               ;end setq
  (setq point new_point)
 ;;изменение координаты y
(setq dy (getreal "\nEnter Offset <exit>: "))
 (setq   new_point
    (subst
      (- (cadr point) dy)      ;new y
      (cadr point)         ;old y
      point         ;list
    )            ;end subst
  )               ;end setq
)
;;;;;;
(defun C:12 (/ p PN pn)
((lambda (p)
   (setq PN nil)
   (if p
     (while (setq pN (cons (change_point p) pN) p (getpoint p "\nВведите следующую точку: "))
       (grdraw (car pN) p 1)
	   )
	)
   (setq PN (reverse pN))
 )
 (getpoint "\nВведите первую точку: ")
)
(apply 'vl-cmdf (append (list "_.PLINE" (car pN) "_W" 0 0) (cdr pN) '("")))
)

Но поведение странное:
Иногда воспринимает оффсет через одну точку
Иногда игнорирует смещение для отдельной точки
"Засечки" резиновой линии проставляются с задаваемым смещением (файл 1.jpg), посторенная полилиния странная (файл 2.jpg) - смещения задавались 50 и 100, но в одном случае не отработало.

Черетж1.dwg:
Белая самая длинная - оригинал, о которого откладывалось смещение.
Для жёлтой полилинии задавал смещение 50, 100 по очереди, последние три значения смещения были 100.
Красная полилиния - начал не с первой точки оригинала, те же 100 и 50 для смещения, в одной точке смыкается с оригиналом.
Нижняя белая полилиния - ход экспериментов, но смыкание с оригиналом тоже видно.

И как сделать смещение для первой точки, в случае указания всех точек оригинальной полилинии ?

Потыкайте, пожалуйста носом, где ошибаюсь.
Заранее признателен.

olezhkooo · 26.04.2016, 13:13

Возможно немного не по теме, но, дабы не создавать отдельную тему, напишу здесь.
Помогите с лиспом. Нужен простейший лисп, который будет рисовать отрезок по заданным длинам проекций X и Y. Например мне нужен отрезок, чтобы проекция по X была 40, а по Y 20.. По функциям, наверно, чтобы было так..: я запускаю лисп и он предлагает указать начальную точку, потом к примеру длину проекции X и далее длину проекции Y.. и всё.. с лиспом не работал уже лет 10 (( всё позабылось..

Александр Ривилис · 26.04.2016, 13:16

А зачем для этого лисп? Запускаешь команду ОТРЕЗОК (_LINE), указываешь первую точку, указываешь вторую точку в виде @X,Y (в данном случае @40,20)

olezhkooo · 26.04.2016, 13:23

Цитата:

Сообщение от Александр Ривилис

А зачем для этого лисп? Запускаешь команду ОТРЕЗОК (_LINE), указываешь первую точку, указываешь вторую точку в виде @X,Y (в данном случае @40,20)

блин.. а точно же.. через относительный ввод..

МишаИнженер · 05.04.2023, 05:58

Цитата:

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

Только 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)))
)

Можно ли используя только данный код добавить в полилинию арочные сегменты?
Или по другому: как добавить в полилинию арочные сегменты не используя VLA объекты?

VVA · 07.04.2023, 09:51

В этой функции нет. Там нужно использовать понятие кривизны (bulge, dxf группа 42) Polyline Bulges
Функции для работы с кривизной можно взять у Lee Mac'a Bulge Conversion Functions

МишаИнженер · 07.04.2023, 09:58

Сделал функцию которая создает LWполилнию из списка точек SpPt и списка радиусов дуг SpArc. Вызывается функция следующим образом:

Код:

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

      
      (setq SpPt (list pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt12 pt13 pt14 pt15 pt16))
      (setq SpArc (list (list 3 (- rd1)) (list 5 (- rd1)) (list 11 (- rd1)) (list 13 (- rd1))))
      (LWPoly SpPt SpArc 1)

Функция не использует функции Visual-Lisp потому что использование (vl-load-com) приводит к торможению компьютера, так как нет функций выгрузки этих функций после их использования.
Сама функция такая:

Код:

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

   (defun LWPoly (lstPt lstArc cls / SpPt pt1b pt2b rArc L05 i j)
  ; Draw lwpolyline in current UCS
  ; version for pre-visual lisp.
  ; lstPt - list of points ((X1 Y1)(X2 Y2) ... (Xn Yn)) in current UCS
  ; lstArc - list or rArc ((NumPi rArci) ... NumPn rArcn)) in current UCS
  ; cls - DXF group 70 flag* to indicate closure : 0 = open, 1 = closed
  ; Сформируем список точек прямолинейной полилинии
	      
        (setq SpPt (mapcar '(lambda (x) (cons 10 x)) lstPt))
    
    ;Добавим в полученный список данные об арочных сегментах
        (foreach lst lstArc 
            (progn
            (setq ni (- (car lst) 1))
            (setq nj (+ ni 1))
            (if (= nj (length lstPt)) (setq nj 0))
	      
            (setq pt1b (nth ni lstPt))
            (setq pt2b (nth nj lstPt))
            (setq rArc (cadr lst))

            (setq L05 (/ (distance pt1b pt2b) 2))
            (setq hkat (sqrt (- (* rArc rArc) (* L05 L05))))
            (setq blg (tan (/ (* 2 (arcsin (/ hkat rArc))) 4)))

            (setq SpPt (append (reverse (member (cons 10 pt1b) (reverse SpPt)))
                              (list (cons 42 blg))
                              (cdr (member (cons 10 pt1b) SpPt))))
	      
               );_ end of progn
        );_ end of foreach
;Создадим определение LWПолилинии в DXF кодах
    	(entmakex (append (list
        (cons 0 "LWPOLYLINE")
        (cons 100 "AcDbEntity")
        (cons 100 "AcDbPolyline")
        (cons 90 (length lstPt))
        (cons 70 cls))
        SpPt))
    ) ;_ end of defun
  
	(defun tan ( x ) (if (not (equal 0.0 (cos x) 1e-10))  (/ (sin x) (cos x))))
	(defun arcsin (x) (* 2.0 (atan (/ x (+ 1 (sqrt (- 1 (* x x))))))))

Файлы с отладочной и без отладочной информации смотрите в приложении

===AAA=== · 08.04.2023, 11:59

Цитата:

... что использование (vl-load-com) приводит к торможению компьютера...

Правда, что ли? И насколько оно критично?

koMon · 08.04.2023, 12:47

Цитата:

Сообщение от ===AAA===

Правда, что ли?

это из серии обс. в последних версиях на протяжении лет 5+ (vl-load-com) ваще загружать не нужно для выполнения vl* функций, коды с их использованием грузятся и исполняются на 123. другое дело реакторы (в хелпере так и прописаны реакторы вначале, а потом туман про некоторые другие функции), но ведь для отрисовки плиниии они и не нужны...

Кулик Алексей aka kpblc · 08.04.2023, 16:12

МишаИнженер, rArc - это у тебя что? Радиус? Так этого мало для определения корректной кривизны.

Цитата:

Сообщение от ===AAA===

Правда, что ли? И насколько оно критично?

Нет конечно.

===AAA=== · 08.04.2023, 17:29

Вот и я не замечал ни разу. :-)

ShaggyDoc · 08.04.2023, 18:40

Ну, вот вариант построения полилинии с помощью entmake. Без ненужных setq, c заданием ширины, "веса" и "трехмерности".

Код:

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

 (defun ru-pline-entmake (points is_closed is_3d width lineweight / elst ENTL)
;;; (ru-pline-entmake (список_вершин) флаг_замкнутости
;;; флаг_делать_3М_ПЛИНИЮ)
;;; возвращает имя примитива - полилинии или NIL, если что-то не
;;; вышло.

;;;(ru-pline-entmake (list (list 0 0) (list 1000 100) (list 1000 2000) (list 0 2000)) nil nil  0 50)

  (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
              (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 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 43 width)
                     (cons 370 lineweight)
                     (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 (function (lambda (p)
                                       (list 10 (car p) (cadr p))
                                     ) ;_ end of lambda
                           ) ;_ end of function
                           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

МишаИнженер · 10.04.2023, 05:33

Цитата:

Сообщение от ===AAA===

Правда, что ли? И насколько оно критично?

Темп черчения замедляется примерно в 10 раз

Кулик Алексей aka kpblc · 10.04.2023, 07:25

Значит отключай приложения по одному - найдешь основной тормоз. А потом код приложения на форум - может, и разберем.

ShaggyDoc · 10.04.2023, 07:26

Цитата:

Сообщение от МишаИнженер

Темп черчения замедляется примерно в 10 раз

Это детские суеверия.
А замедляют работы многочисленные последовательные вызовы функции setq.
Это ведь не "оператор присваивания", а именно функция, которую и загрузить надо, и проанализировать пары аргументов на корректность.

МишаИнженер · 10.04.2023, 07:35

Чтобы увидеть эффект торможения поставьте время автосохранения 5м и откройте одновременно 5 разных файлов. Запустите любой инструмент в котором есть строка (vl-load-com) (При этом, я так подозреваю в память Автокада кроме нужных функций загрузится всякий, неоптимизированный и неотлаженный мусор, который выгрузить уже нельзя) Через 5 минут АвтоКад начнет дико тормозить, потому что при каждом сохранении файла Автокад выполняет перекомпиляцию всех загруженных проектов и инструментов. Так было при использовании загруженных файлов *.dvb. Стоит загрузить хоть один файл *.dvb и время сохранения файлов увеличивается примерно раз в 10.
Поэтому у меня появилось правило: если появляется необходимость добавлять строку кода (vl-load-com) дальше программировать практически нет смысла. Приложение получится очень тормозным и "неэффективным" в некотором смысле. Только в особых случаях можно дальше писать код: когда других способов решить проблему не находится.

ShaggyDoc · 10.04.2023, 09:06

Цитата:

Сообщение от МишаИнженер

Так было при использовании загруженных файлов *.dvb. Стоит загрузить хоть один файл *.dvb и время сохранения файлов увеличивается примерно раз в 10.
Поэтому у меня появилось правило: если появляется необходимость добавлять строку кода (vl-load-com)

Глупости. При чем тут dvb и сохранение файлов?

Сергей812 · 10.04.2023, 14:16

Цитата:

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

Глупости. При чем тут dvb и сохранение файлов?

отсюда, наверно)

ShaggyDoc · 10.04.2023, 15:09

Цитата:

Сообщение от Сергей812

отсюда, наверно)

Ну и зачем же использовать уродца VBA? Надо чего-то "эдакое" - есть .NET, ObjectARX.
Так и они не нужны для "мишиных задач".

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

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
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

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