[sialiv]

Требуется консультация:
1 - макрос Lisp рисует линии, до 500 штук проблем нет.
2 - свыше 500 штук начинаются глюки.Линии путаются и самое интерестное их запутывание меняется с изменением масштаба отображения в окне Автокад.

Вопрос: В чем может быть проблемма?

[Хмурый]

навскидку.
очищать память от ненужных наборов. команда (gc)

[Александр Ривилис]

Навскидку. Проблема в привязках. Вариантов решения несколько:
1) Отключить привязки: (setvar "OSMODE" 0)
2) Перед вводом координат в функции (command ...) использовать "_none". Например:

Код:

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

(command "_.LINE" "_none" p1 "_none" p2 "")

[ShaggyDoc]

В чем может быть проблемма?

Не глядя - проблема в плохом коде. Во множестве возможных вариаций. "Children_error_number_one" указал Александр Ривилис. Могут быть и другие.

[sialiv]

Применил (gc) - частично помогло...
Применил (setvar "OSMODE" 0) - еще помогло...
Число линий создано автоматически дошло до 2086 штук, а дальше терпения не хватает, надо что-то делать с алгоритмом скорость обработки падает до 1 линии за 5секунд.

[Alan]

Сообщение от sialiv Применил (gc) - частично помогло... Применил (setvar "OSMODE" 0) - еще помогло... Число линий создано автоматически дошло до 2086 штук, а дальше терпения не хватает, надо что-то делать с алгоритмом скорость обработки падает до 1 линии за 5секунд.

Так код покажи и м.б. закончим с этой проблемой. Или очень секретный?

[sialiv]

Желающие могут ознакомиться с кодом, Auto_Wire.rar
Только куда разместить? Могу отправить на почту.
Вчера испытывал дальше код, глюк опять появился, только теперь он появляется когда изображение на экране сильно уменьшено или увеличино, что делать не знаю...

[VictorHunter]

к посту прикрепи

[sialiv]

Еще вопрос:
Как редактировать список не относящийся к примитиву например:
(setq LL '( (1 2 3) (a b c) (1 a 0) )), как заменить элемент 'b' во второй записи не создавая список занoво?

[ShaggyDoc]

По коду. Задача сложная, многоцикловая, надо оптимизировать.

1. Совсем явная ошибка - рисование полилинией без отключения
привязок.

Зачем вообще PLINE, если передаются только две точки? А ведь у полилинии еще ширина есть (witdh) и она будет непредсказуемо вылезать.

Вообще эту "рисовальную" часть надо сделать через ActiveX - и работает во много раз быстрее (что в этой программе критично) и ошибки отловить можно. Обернуть в обработчик ошибок функцию vla-addline и будет видно, где ломается.

2. Выбор (ssget "_C" ...) абсолютно ненадежен. На этом, видимо и ломается. Такой выбор (а также рамкой) работает только если примитивы видны на экране. Видимо надо делать перебор и аналитическое определение пересчений функцией inters.

3. Надо учитывать системы координат. В функцию command должны передаваться координаты только в ПСК, а получены они бывают, как правило, в МСК. Для ActiveX методов наоборот, все координаты в МСК.

4. Код надо оптимизирвать. Последовательный вызов setq надо убирать. Это приводит к тому, что функция каждый раз подгружается, анализирует аргументы и выполняется. А можно сделать только один вызов. Вместо

Код:

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

  (setq num nn);исходная точка
  (setq count (length v_xyz));количество точек соединения
  (setq l_xyz '());список точек на линии соединения
  (setq vtip (V_revers vtip));тип точки встречного соединения
  (setq num (1+ num));пропустить исходную точку

писать

Код:

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

  (setq num nn                   ;исходная точка
          count (length v_xyz) ;количество точек соединения
          l_xyz '()                  ;список точек на линии соединения
          vtip (V_revers vtip)  ;тип точки встречного соединения
          num (1+ num)         ;пропустить исходную точку
 )

Это ускорит работу. Кроме того, такую напряженную функцию надо запускать в откомпилированном виде.

[sialiv]

БЛАГОДАРНОСТИ: ShaggyDoc , Александр Ривилис , Хмурый
Предела совершенству нет...

Последние испытания:
Глюки кончились.
Время обработки:
7232/3456 точек/линий для связи - 13 минут (9 точек/секунда)
10848/5244 точек/линий для связи - 37 минут (4.8 точек/секунда)
Еще раз всем спасибо!!!

[Кулик Алексей aka kpblc]

Времени не хватает катастрофически, поэтому только первые наброски.

Код:

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

(vl-load-com)

(setq adoc (vla-get-activedocument (vlax-get-acad-object)))

(defun loc:get-connection-point-by-block-reference (blk-ref / res blk_def blk_def_lst origin ins rot norm)
  (if (and (setq blk-ref (cond
                           ((= (type blk-ref) 'ename) (vlax-ename->vla-object blk-ref))
                           ((= (type blk-ref) 'vla-object) blk-ref)
                           ) ;_ end of cond
                 ) ;_ end of setq
           (wcmatch (strcase (vla-get-objectname blk-ref)) "*BLOCK*")
           ) ;_ end of and
    (progn
      (setq blk_def     (vla-item (vla-get-blocks adoc) (vla-get-name blk-ref))
            origin      (vlax-safearray->list (vlax-variant-value (vla-get-origin blk_def)))
            ins         (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint blk-ref)))
            rot         (vla-get-rotation blk-ref)
            norm        (vlax-safearray->list (vlax-variant-value (vla-get-normal blk-ref)))
            blk_def_lst (vl-remove-if-not
                          (function
                            (lambda (x)
                              (wcmatch (strcase (vla-get-objectname x)) "*BLOCK*")
                              ) ;_ end of lambda
                            ) ;_ end of function
                          ((lambda (/ res)
                             (vlax-for sub blk_def
                               (setq res (cons sub res))
                               ) ;_ end of vlax-for
                             (reverse res)
                             ) ;_ end of lambda
                           )
                          ) ;_ end of vl-remove-if-not
            res         '(("U") ("R") ("L") ("D"))
            ) ;_ end of setq
      (foreach item blk_def_lst
        (setq res (subst
                    (cons (vla-get-name item)
                          (cons (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint item)))
                                (cdr (assoc (vla-get-name item) res))
                                ) ;_ end of append
                          ) ;_ end of cons
                    (assoc (vla-get-name item) res)
                    res
                    ) ;_ end of subst
              ) ;_ end of setq
        ) ;_ end of foreach
      (setq res (mapcar
                  (function
                    (lambda (x)
                      (cons (car x)
                            (mapcar
                              (function
                                (lambda (b)
                                  (trans (mapcar (function +) b ins) '(0 0 1) norm)
                                  ) ;_ end of lambda
                                ) ;_ end of function
                              (mapcar
                                (function
                                  (lambda (a)
                                    (polar origin (+ rot (angle origin a)) (distance origin a))
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                (cdr x)
                                ) ;_ end of mapcar
                              ) ;_ end of mapcar
                            ) ;_ end of cons
                      ) ;_ end of lambda
                    ) ;_ end of function
                  res
                  ) ;_ end of mapcar
            ) ;_ end of setq
      ) ;_ end of progn
    ) ;_ end of if
  (cons blk-ref res)
  ) ;_ end of defun

Ну и проверка без особых наворотов

Код:

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

(defun test (/ lst)
  (setq lst (loc:get-connection-point-by-block-reference (car (entsel))))
  (mapcar
    (function
      (lambda (x)
        (mapcar
          (function
            (lambda (a)
              (entmakex (list (cons 0 "POINT")
                              (cons 10 a)
                              (cons 62
                                    (cond ((= (car x) "U") 1)
                                          ((= (car x) "D") 2)
                                          ((= (car x) "L") 3)
                                          (t 4)
                                          ) ;_ end of cond
                                    ) ;_ end of cons
                              ) ;_ end of list
                        ) ;_ end of entmakex
              ) ;_ end of lambda
            ) ;_ end of function
          (cdr x)
          ) ;_ end of mapcar
        ) ;_ end of lambda
      ) ;_ end of function
    (cdr lst)
    ) ;_ end of mapcar
  ) ;_ end of defun

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