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

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

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

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

Всем привет. Возник небольшой вопрос: можно ли как то нарисовать полилинию (_pline) по имеющимся координатам точек в списке lisp? Т.е. список состоит из точечных пар, и надо по этим точкам отрисовать полилинию. Если нет идей, то подскажите пожалуйста где об этом почитать можно.
Просмотров: 24545
 
Непрочитано 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. Я выбрал мешанину из обоих путей, т.е в одной программе, у меня используются оба метода.
__________________
Чем гениальнее ваш план, тем меньше людей с ним будут согласны.
/Сунь Цзы/
Елпанов Евгений вне форума  
 
Непрочитано 13.02.2011, 10:02
#21
Disney

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


Цитата:
Сообщение от 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-иться всё постоянно, чтоб сравниваемые функции были идентичными.
__________________
Почему все вдруг становятся умными, когда уже не надо?
Disney вне форума  
 
Непрочитано 13.02.2011, 12:01
#22
Li6-D


 
Регистрация: 03.05.2009
Сообщений: 112


Самое простое, что можно предложить автору темы:
Код:
[Выделить все]
;|Выражение для рисования незамкнутой 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Введите первую точку: ")
)

Последний раз редактировалось Li6-D, 13.02.2011 в 13:34.
Li6-D вне форума  
 
Непрочитано 14.04.2012, 18:24
#23
SteelBrother

Проектировщик
 
Регистрация: 14.08.2011
Екатеринбург
Сообщений: 58
<phrase 1=


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

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


В ту функцию точки передаются в текущей UCS.
Александр Ривилис вне форума  
 
Непрочитано 14.04.2012, 18:40
#25
SteelBrother

Проектировщик
 
Регистрация: 14.08.2011
Екатеринбург
Сообщений: 58
<phrase 1=


уточню. в текущей? или в МСК?
SteelBrother вне форума  
 
Непрочитано 14.04.2012, 18:49
#26
Александр Ривилис

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


Цитата:
Сообщение от VVA Посмотреть сообщение
; lst - list of points ((X1 Y1)(X2 Y2) ... (Xn Yn)) in current UCS
UCS - это ПСК. WCS - это МСК. Данная функция считает, что точки передаются ей в текущей ПСК (current UCS)
Александр Ривилис вне форума  
 
Непрочитано 14.04.2012, 18:56
#27
SteelBrother

Проектировщик
 
Регистрация: 14.08.2011
Екатеринбург
Сообщений: 58
<phrase 1=


спасибо. понял.
SteelBrother вне форума  
 
Непрочитано 19.02.2014, 21:13
#28
Eghor123


 
Регистрация: 15.11.2011
Сообщений: 130


Цитата:
Сообщение от Елпанов Евгений Посмотреть сообщение
ACET-PLINE-MAKE
а что это вообще за функции такие? чет мне про них ничего не известно
Eghor123 вне форума  
 
Непрочитано 19.02.2014, 21:39
#29
Кулик Алексей aka kpblc
Moderator

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


Из ExpressTools
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 25.12.2014, 17:49
#30
alex101000


 
Регистрация: 23.11.2011
Сообщений: 175


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


 
Регистрация: 23.11.2011
Сообщений: 175


Голова поломалась. Запутался в строке вусмерть.
Код:
[Выделить все]
 (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 вот это ?
alex101000 вне форума  
 
Непрочитано 30.12.2014, 14:22
1 | #32
VVA

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


Цитата:
Сообщение от alex101000 Посмотреть сообщение
(setq pN (cons p pN) p вот это ?
Это СПИСОК точек
Цитата:
Сообщение от alex101000 Посмотреть сообщение
Уже на (getpoint p "\nВведите...") торможу, ведь обычно запись вида (setq p (getpoint "\nВведите...")).
Это необязательный параметр, нужен для отображения резиновой линии.
Если раздражает, можно и убрать
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 13.01.2015, 15:00
#33
alex101000


 
Регистрация: 23.11.2011
Сообщений: 175


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 для смещения, в одной точке смыкается с оригиналом.
Нижняя белая полилиния - ход экспериментов, но смыкание с оригиналом тоже видно.

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

Потыкайте, пожалуйста носом, где ошибаюсь.
Заранее признателен.
Миниатюры
Нажмите на изображение для увеличения
Название: 1.jpg
Просмотров: 97
Размер:	366.4 Кб
ID:	141868  Нажмите на изображение для увеличения
Название: 2.jpg
Просмотров: 87
Размер:	376.2 Кб
ID:	141869  
Вложения
Тип файла: dwg
DWG 2010
Чертеж1.dwg (148.4 Кб, 703 просмотров)
alex101000 вне форума  
 
Непрочитано 26.04.2016, 13:13
#34
olezhkooo

Проектирование
 
Регистрация: 06.08.2012
СПб
Сообщений: 163


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

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



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

Проектирование
 
Регистрация: 06.08.2012
СПб
Сообщений: 163


Цитата:
Сообщение от Александр Ривилис Посмотреть сообщение
А зачем для этого лисп? Запускаешь команду ОТРЕЗОК (_LINE), указываешь первую точку, указываешь вторую точку в виде @X,Y (в данном случае @40,20)
блин.. а точно же.. через относительный ввод..
olezhkooo вне форума  
 
Непрочитано 05.04.2023, 05:58
#37
МишаИнженер


 
Регистрация: 14.12.2008
Сообщений: 1,079


Цитата:
Сообщение от 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 объекты?
МишаИнженер вне форума  
 
Непрочитано 07.04.2023, 09:51
1 | #38
VVA

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


В этой функции нет. Там нужно использовать понятие кривизны (bulge, dxf группа 42) Polyline Bulges
Функции для работы с кривизной можно взять у Lee Mac'a Bulge Conversion Functions
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 07.04.2023, 09:58
#39
МишаИнженер


 
Регистрация: 14.12.2008
Сообщений: 1,079


Сделал функцию которая создает 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))))))))
Файлы с отладочной и без отладочной информации смотрите в приложении
Вложения
Тип файла: lsp LWPolyLine_EM.lsp (1.9 Кб, 15 просмотров)
Тип файла: lsp LWPolyLine_EM (debug).lsp (2.9 Кб, 15 просмотров)

Последний раз редактировалось МишаИнженер, 07.04.2023 в 16:05.
МишаИнженер вне форума  
 
Непрочитано 08.04.2023, 11:59
#40
===AAA===


 
Регистрация: 15.08.2005
г. Норильск
Сообщений: 451


Цитата:
... что использование (vl-load-com) приводит к торможению компьютера...
Правда, что ли? И насколько оно критично?
__________________
Счастливо, Алексей!
===AAA=== вне форума  
 
Непрочитано 08.04.2023, 12:47
#41
koMon


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


Цитата:
Сообщение от ===AAA=== Посмотреть сообщение
Правда, что ли?
это из серии обс. в последних версиях на протяжении лет 5+ (vl-load-com) ваще загружать не нужно для выполнения vl* функций, коды с их использованием грузятся и исполняются на 123. другое дело реакторы (в хелпере так и прописаны реакторы вначале, а потом туман про некоторые другие функции), но ведь для отрисовки плиниии они и не нужны...
__________________
K Lisp
koMon вне форума  
 
Непрочитано 08.04.2023, 16:12
#42
Кулик Алексей aka kpblc
Moderator

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


МишаИнженер, rArc - это у тебя что? Радиус? Так этого мало для определения корректной кривизны.
Цитата:
Сообщение от ===AAA=== Посмотреть сообщение
Правда, что ли? И насколько оно критично?
Нет конечно.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 08.04.2023, 17:29
#43
===AAA===


 
Регистрация: 15.08.2005
г. Норильск
Сообщений: 451


Вот и я не замечал ни разу. :-)
__________________
Счастливо, Алексей!
===AAA=== вне форума  
 
Непрочитано 08.04.2023, 18:40
#44
ShaggyDoc

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


Ну, вот вариант построения полилинии с помощью 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
ShaggyDoc вне форума  
 
Непрочитано 10.04.2023, 05:33
#45
МишаИнженер


 
Регистрация: 14.12.2008
Сообщений: 1,079


Цитата:
Сообщение от ===AAA=== Посмотреть сообщение
Правда, что ли? И насколько оно критично?
Темп черчения замедляется примерно в 10 раз
МишаИнженер вне форума  
 
Непрочитано 10.04.2023, 07:25
#46
Кулик Алексей aka kpblc
Moderator

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


Значит отключай приложения по одному - найдешь основной тормоз. А потом код приложения на форум - может, и разберем.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 10.04.2023, 07:26
#47
ShaggyDoc

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


Цитата:
Сообщение от МишаИнженер Посмотреть сообщение
Темп черчения замедляется примерно в 10 раз
Это детские суеверия.
А замедляют работы многочисленные последовательные вызовы функции setq.
Это ведь не "оператор присваивания", а именно функция, которую и загрузить надо, и проанализировать пары аргументов на корректность.
ShaggyDoc вне форума  
 
Непрочитано 10.04.2023, 07:35
#48
МишаИнженер


 
Регистрация: 14.12.2008
Сообщений: 1,079


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

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


Цитата:
Сообщение от МишаИнженер Посмотреть сообщение
Так было при использовании загруженных файлов *.dvb. Стоит загрузить хоть один файл *.dvb и время сохранения файлов увеличивается примерно раз в 10.
Поэтому у меня появилось правило: если появляется необходимость добавлять строку кода (vl-load-com)
Глупости. При чем тут dvb и сохранение файлов?
ShaggyDoc вне форума  
 
Непрочитано 10.04.2023, 14:16
#50
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


Цитата:
Сообщение от ShaggyDoc Посмотреть сообщение
Глупости. При чем тут dvb и сохранение файлов?
отсюда, наверно)
Сергей812 вне форума  
 
Непрочитано 10.04.2023, 15:09
#51
ShaggyDoc

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


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
отсюда, наверно)
Ну и зачем же использовать уродца VBA? Надо чего-то "эдакое" - есть .NET, ObjectARX.
Так и они не нужны для "мишиных задач".
ShaggyDoc вне форума  
Ответ
Вернуться   Форум 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