Некорректно работают методы задания новых координат для полилинии

Maksim Yablokv · April 8

Всем привет!

Столкнулся ещё с одним багом.

В частности, некорректно работают методы задания новых координат для полилинии.

Проверил так: (vlax-put {Object} 'Coordinates {ListPoints}) и так: (vla-put-Coordinates {Object} {VariantPoints})

Результат один - неверный. Правда, не во всех случаях)

Ошибка проявляется когда для полилинии устанавливаем более короткий список вершин.

Во вложении видео с тестовой командой TestLW, где я создаю новую полилинию поверх восьмигранника, а затем, указывая новые вершины треугольника, пытаюсь её преобразовать. В результате получаю полилинию не в виде треугольника, а что-то иное, частично позаимствованное от старой фигуры.

Тестовый Lisp файл во вложении.

TestLW.LSP

kpblc · April 8

Возможно, дело в том, что в nanocad координаты даже LightweightPolyline используются как трехмерные точки, а не двумерные.

Попробуй заменить строку

(setq coords (cons (list (car p) (cadr p)) coords))

на

(setq coords (cons p coords))

Ну и в конце функции ИМХО не помешает сделать для coords reverse

Maksim Yablokv · April 8

37 минут назад, kpblc сказал:

Возможно, дело в том, что в nanocad координаты даже LightweightPolyline используются как трехмерные точки, а не двумерные.

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

А при попытке замены координат на трёхмерные, значение по оси Z воспринимается за плановую ось. Z точно лишняя.

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

Это дичь конечно)

(while
	  (not(equal coords (vlax-get pline 'Coordinates)))
	  (vlax-put pline 'Coordinates coords)
	  )

Edited April 8 by Maksim Yablokv

Maksim Yablokv · April 8

Вот так результат правильный:

(defun c:TestLW (/ AddLWPolyline GetListPoint coords pline)
  (vl-load-com)
  (defun AddLWPolyline (coords / aсdoc space сlosed pline)
    (setq aсdoc (vla-get-activedocument (vlax-get-acad-object))
	  space (if (= (getvar "CVPORT") 1)
		  (vla-get-paperspace aсdoc)
		  (vla-get-modelspace aсdoc)
		  )
	  coords (apply 'append coords)
	  )
    (vlax-invoke space 'AddLightWeightPolyline coords)
    )
  (defun GetListPoint (/ p coords)
    (while (setq p (getpoint
		     (strcat "\n Укажите не менее двух точек <" (itoa(length coords)) ">: ")
		     ))
      (setq coords (cons (list(car p)(cadr p)) coords))
      )
    (if(< 1 (length coords)) (reverse coords))
    )
  (if (setq coords (GetListPoint))
    (progn
      (setq pline (AddLWPolyline coords))
      (while (setq coords (GetListPoint))
	(setq coords (apply 'append coords))
	(while
	  (not(equal coords (vlax-get pline 'Coordinates)))
	  (vlax-put pline 'Coordinates coords)
	  )
	)
      )
    )
  (princ)
  )

TestLW.LSP

Maksim Yablokv · April 8

Обновлённый вариант. Костыль №2

Т.к. вставка большего числа вершин работает корректно, то нет смысла сравнивать в цикле весь список.

Будет достаточно взять первые две вершины, в цикле добиться соответствия, а потом применить полный список новых точек.

Как-то так:


(defun c:TestLW (/ AddLWPolyline GetListPoint put-Coordinates coords pline)
  (vl-load-com)
  (defun AddLWPolyline (coords / aсdoc space сlosed pline)
    (setq aсdoc (vla-get-activedocument (vlax-get-acad-object))
	  space (if (= (getvar "CVPORT") 1)
		  (vla-get-paperspace aсdoc)
		  (vla-get-modelspace aсdoc)
		  )
	  coords (apply 'append coords)
	  )
    (vlax-invoke space 'AddLightWeightPolyline coords)
    )
  (defun GetListPoint (/ p coords)
    (while (setq p (getpoint
		     (strcat "\n Укажите не менее двух точек <" (itoa(length coords)) ">: ")
		     ))
      (setq coords (cons (list(car p)(cadr p)) coords))
      )
    (if(< 1 (length coords)) (reverse coords))
    )
  (defun put-Coordinates (pline coords / temp)
    ;берём только две первые точки из списка
    ;так будет проще и быстрей проходить сравнение
    (setq temp (list (car coords) (cadr coords)
		     (caddr coords) (cadddr coords)))
    ;работаем в цикле пока не добъёмся полного соответствия
    (while (not(equal temp (vlax-get pline 'Coordinates)))
      (vlax-put pline 'Coordinates temp)
      )
    ;применяем полный список точек
    (vlax-put pline 'Coordinates coords)
    )
  (if (setq coords (GetListPoint))
    (progn
      (setq pline (AddLWPolyline coords))
      (while (setq coords (GetListPoint))
	(setq coords (apply 'append coords))
	(put-Coordinates pline coords)
	)
      )
    )
  (princ)
  )

Edited April 8 by Maksim Yablokv

kpblc · April 9

Ну не знаю - у меня такие коды сработали вполне себе корректно (nanocad 23):

(vl-load-com)

(defun c:testlw-ent (/ fun_get-vertexes vertex_list) 

  (defun fun_get-vertexes (/ point res) 
    (while 
      (and 
        (= 
          (type 
            (setq point (vl-catch-all-apply (function (lambda () (getpoint "\nPick vertex <Cancel> : ")))))
          ) ;_ end of type
          'list
        ) ;_ end of =
        point
      ) ;_ end of and
      (setq res (cons point res))
    ) ;_ end of while
    (if (> (length res) 1) 
      (reverse res)
    ) ;_ end of if
  ) ;_ end of defun

  (if (setq vertex_list (fun_get-vertexes)) 
    (entmakex 
      (append 
        (list '(0 . "LWPOLYLINE") 
              '(100 . "AcDbEntity")
              '(100 . "AcDbPolyline")
              (cons 90 
                    (length vertex_list)
              ) ;_ end of cons
        ) ;_ end of list
        (mapcar (function (lambda (x) (cons 10 x))) vertex_list)
      ) ;_ end of append
    ) ;_ end of entmakex
  ) ;_ end of if

  (princ)
) ;_ end of defun

(defun c:testlw-vla (/ fun_get-vertexes _kpblc-get-active-space-obj vertex_list adoc space) 

  (defun fun_get-vertexes (/ point res) 
    (while 
      (and 
        (= 
          (type 
            (setq point (vl-catch-all-apply 
                          (function 
                            (lambda () 
                              (getpoint "\nPick vertex <Cancel> : ")
                            )
                          )
                        )
            )
          )
          'list
        )
        point
      ) ;_ end of and
      (setq res (cons point res))
    ) ;_ end of while
    (if (> (length res) 1) 
      (reverse res)
    ) ;_ end of if
  ) ;_ end of defun

  (defun _kpblc-get-active-space-obj (doc) 
    (if 
      (and (zerop (vla-get-activespace doc)) 
           (equal :vlax-false (vla-get-mspace doc))
      )
      (vla-get-paperspace doc)
      (vla-get-modelspace doc)
    ) ;_ end of if
  ) ;_ end of defun

  (if (setq vertex_list (fun_get-vertexes)) 
    (progn 
      (setq adoc        (vla-get-activedocument (vlax-get-acad-object))
            vertex_list (apply (function append) (mapcar (function (lambda (x) (list (car x) (cadr x)))) vertex_list))
      )
      (vla-addlightweightpolyline 
        (_kpblc-get-active-space-obj adoc)
        (vlax-make-variant 
          (vlax-safearray-fill 
            (vlax-make-safearray 
              vlax-vbdouble
              (cons 0 (1- (length vertex_list)))
            )
            vertex_list
          ) ;_ end of vlax-safearray-fill
        ) ;_ end of vlax-make-variant
      ) ;_ end of vla-AddLightWeightPolyline
    ) ;_ end of progn
  ) ;_ end of if

  (princ)
) ;_ end of defun

kpblc · April 9

Спойлер

Добавлю: код написан на коленке, поэтому принцип DRY не соблюден

;; И на закуску, пока есть время. Без проверок, написано "насухую"
(defun _kpblc-set-coordinates (pline-ent vertex-list) 
  ;|
    *    Назначает координаты полилинии
    *    Параметры вызова:
      pline-ent   ; vla- или ename-указатель на примитив полилинии. Примитив должен лежать на размороженном и разблокированном слое
      vertex-list ; список 2D- или 3D-точек.
    *    Примеры вызова:
    (_kpblc-set-coordinates (car (entsel "\nSelect lwpolyline : ")) '((0. 0. 0.) (1. 1.) (2. 3)))
    |;
  (if (= (type pline-ent) 'ename) 
    (setq pline-ent (vlax-ename->vla-object pline-ent))
  )
  (setq vertex-list (apply 
                      (function append)
                      (mapcar (function (lambda (x) (list (car x) (cadr x)))) 
                              vertex-list
                      )
                    )
  )
  (vla-put-coordinates pline-ent 
                       (vlax-make-variant 
                         (vlax-safearray-fill 
                           (vlax-make-safearray 
                             vlax-vbdouble
                             (cons 0 (1- (length vertex-list)))
                           )
                           vertex-list
                         )
                       )
  )
)

Edited April 9 by kpblc

Maksim Yablokv · April 9

Алексей, спасибо за внимание к проблеме!

Всё бы хорошо, но (vla-put-Coordinates {Object} {VariantPoints}) так же некорректно работает.

В итоге решил написать такую заплатку:

  ;;;************************************************
  ;;; pline - vla-указатель на примитив полилинии.
  ;;; coords - список 2D или 3D точек.
  (defun Put-Coordinates (pline coords / temp)
    ;берём только первую точку из списка
    ;так будет быстрее проходить сравнение
    (if (eq (vlax-get pline 'Objectname) "AcDbPolyline")
      (setq temp (list(car coords)(cadr coords)
		      (car coords)(cadr coords)))
      (setq temp (list(car coords)(cadr coords)(caddr coords)
		      (car coords)(cadr coords)(caddr coords)))
      )
    ;работаем в цикле пока не добъёмся полного соответствия
    (while (not(equal temp (vlax-get pline 'Coordinates)))
      (vlax-put pline 'Coordinates temp)
      )
    ;применяем полный список точек
    (vlax-put pline 'Coordinates coords)
    )

Пока работает стабильно хорошо, как для LW так и для 3D полилинии.

Edited April 9 by Maksim Yablokv

kpblc · April 9

Я проверял на 23-й версии. А на какой "не работает"?

Maksim Yablokv · April 9

2 часа назад, kpblc сказал:

Я проверял на 23-й версии. А на какой "не работает"?

На 22 версии!

kpblc · April 9

Ох, елки... Придется сейчас запрашивать лицензию на 22 чтобы проверить и посмотреть что можно сделать.

doctorraz · April 9

9 минут назад, kpblc сказал:

Придется сейчас запрашивать лицензию на 22

Не придется, нк22 и старше будут работать с лицензией от нк23

Единственное имха нежелательно ставить старые после новых((

Maksim Yablokv · April 9

10 минут назад, kpblc сказал:

Ох, елки... Придется сейчас запрашивать лицензию на 22 чтобы проверить и посмотреть что можно сделать.

Алексей, т.к. у вас целая коллекция лиспов, то хотел бы обратить ваше внимание ещё на один существенный баг.
Функция vl-position при работе со списком возвращает nil

Разработчики NC обещают исправить в новом релизе.

Команда: (vl-position '(1) '((0) (1) (2)))
nil
Команда: (vl-position (list 1) (list '(0) '(1) '(2)))
nil
Команда: (vl-position (list 1) (list (list 0) (list 1) (list 2)))
nil
Команда: (vl-position "B" '("A" "B" "C"))
2
Команда: (vl-position 'B '(A B C))
2

kpblc · April 9

2 минуты назад, doctorraz сказал:

Единственное имха нежелательно ставить старые после новых((

Блин! Значит, придется еще одну виртуалку поднимать Грустька, пичалька, злобик, гневик

Место на винте катастрофически быстро кончается.

добавлено через 1 минуту

2 минуты назад, Maksim Yablokv сказал:

Функция vl-position при работе со списком возвращает nil

А что будет если использовать member?

Maksim Yablokv · April 9

Собственно заплатка для vl-position

(defun ATP:vl-position (item l / ll)
(if (setq ll (member item l))
(- (length l)(length ll))
)
)

добавлено через 1 минуту

3 минуты назад, kpblc сказал:

А что будет если использовать member?

Будет всё хорошо

kpblc · April 9

Откровенно говоря, я не пользовал vl-position широко, поскольку смысла в нем не видел. member срабатывает - и ладушки, обычно не требовалось узнавать номер позиции найденного элемента. Но! Это всего лишь мои приколы и мой личный опыт, не более.

doctorraz · April 9

29 минут назад, kpblc сказал:

Значит, придется еще одну виртуалку поднимать

красиво жить не запретишь((

но у меня прекрасно на боевой машине уживаются адын нк20, ~~две куртки замшевые~~ два нк22 и ~~два~~ нк23

просто надо ставить от старых к новым

предвосхищая вопрос а нафига.. дык баги разные, то что умеет нк20, нана 23 разучился или косячит и наоборот, поэтому зверинец

32 минуты назад, kpblc сказал:

Основная версия для кодов - 23 и более поздние (когда они появятся).

уот я бы не был так оптимистичен, в уверенности того, что в новых версиях будет работать код от прежних(((

kpblc · April 9

Ну когда будет - тогда и буду ковыряться. На данный момент все равно дома только 23, тем и живу

Спойлер

А уж сколько я пота пролил, пытаясь заставить NET работать с SQL-базой под 23 nanoCAD - уууу... И это еще Postgre не нарисовался в полный рост в режиме "не сотрешь".

добавлено через 1 минуту

3 минуты назад, doctorraz сказал:

просто надо ставить от старых к новым

У меня уже установлен 23, сносить как-то не хочется. Хвосты 100% останутся и будут мешать, я практически уверен.

Edited April 9 by kpblc

doctorraz · April 9

13 минут назад, kpblc сказал:

Хвосты 100% останутся и будут мешать, я практически уверен.

не останутся, тем боле ты потом опять нк23 поставишь

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

kpblc · April 9

Тоже верно... Ну, все равно раньше вторника до рабочего компа не доберусь А там посмотрим

kpblc · April 11

Проверил поведение кодов на nanoCAD 20 и 23. Само по себе создание полилинии (testlw-ent, testlw-vla) срабатывает вполне корректно. Но вот (_kpblc-set-coordinates (car (entsel "\nSelect lwpolyline : ")) '((0. 0. 0.) (1. 1.) (2. 3))) при указании полилинии с количество вершин более 3 приводит к непредсказуемому результату. Такое ощущение, что перезаписываются координаты только первых трех вершин, остальные оставляются "как есть".

Так что использовать мой подход для модификации полилинии не получится. А жаль В ACAD все срабатывает "как надо".

EdwardSt · April 11

Плохо, что в функциях постоянно вылезают какие-то недоделки, переделки или просто отсутствие реализации.

Потому использование ограниченного набора проверенных "старинных" функций зачастую является более эффективным.

Заранее прошу прощения у гуру о корявости кода, но прилагаю версию с решением задачи.

Попутно решен вопрос о независимости запроса точек от текущей UCS.

И, конечно, это не отменяет актуальности выявленных выше багов функции (vlax-put.

Кстати, в справке по АС теперь эта функция подается с новым названием (vlax-put-property, хотя поддержка старой транскрипции наверняка сохранена (не проверял).

testLW.lsp

EdwardSt · April 12

В 09.04.2023 в 19:36, Maksim Yablokv сказал:

Функция vl-position при работе со списком возвращает nil

Разработчики NC обещают исправить в новом релизе.

Команда: (vl-position '(1) '((0) (1) (2)))
nil
Команда: (vl-position (list 1) (list '(0) '(1) '(2)))
nil
Команда: (vl-position (list 1) (list (list 0) (list 1) (list 2)))
nil
Команда: (vl-position "B" '("A" "B" "C"))
2
Команда: (vl-position 'B '(A B C))
2

А в чем баг в перечисленных примерах?

Вроде все отрабатывается, как и задумано.

Спойлер

image.png.4e1784d49c3095bdc3d165a77c4c78f5.png

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

Искомые элементы в четвертом (строка) и пятом (символ) являются допустимыми для поиска и потому для них есть результат.

ЗЫ. Хотя в АС14 список может быть искомым элементом!

Хорошо бы проверить в версиях АС старше 19, откуда приведен фрагмент справки.

Edited April 12 by EdwardSt

kpblc · April 12

В 11.04.2023 в 11:39, EdwardSt сказал:

это не отменяет актуальности выявленных выше багов функции (vlax-put.

Кстати, в справке по АС теперь эта функция подается с новым названием (vlax-put-property, хотя поддержка старой транскрипции наверняка сохранена (не проверял).

Возможно, есть какая-то разница в поведении по аналогии с vlax-invoke и vlax-invoke-method.

1 час назад, EdwardSt сказал:

Хорошо бы проверить в версиях АС старше 19, откуда приведен фрагмент справки.

ACAD2021:

_$ (VL-POSITION '(1) '((0) (2) (1) (3)))
2
_$

EdwardSt · April 12

10 минут назад, kpblc сказал:
ACAD2021:

_$ (VL-POSITION '(1) '((0) (2) (1) (3))) 2 _$
_$ (VL-POSITION '(1) '((0) (2) (1) (3)))
2
_$ 

Получается, что NC делает строго по справке, а AC сам себе противоречит )))

Для совместимости и просто исходя из здравого смысла лучше игнорировать справку и реализовать, как сейчас в АС.

Некорректно работают методы задания новых координат для полилинии

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Join the conversation

Tell a friend

Similar Content