[Golem-iq]

Есть дерево состоящее из линий:

Нужно в свободных конечных точках нарисовать треугольники (помечено жёлтым):

Я написал LISP код, который это делает. Но не могу избавится от лишних элементов отрисовки (красным) и не дорисовки (жёлтым)


Вот листинги кода:

На поиск точки:

Код:

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

 ;;Ставит все метки, согласно ориентации
(defun c:difall()
  (setq ds 10)
  (command "_.layer" "_set" "ventline" "")
  (setq layer (cons 8 "ventline")
        lines (ssget "_x" (list '(0 . "LINE") layer))
        i1 0
  )
  (while (< i1 (sslength lines))
    (setq ll1 (entget (ssname lines i1)))
    (setq 
       ca1 (list (car (cdr (assoc 10 ll1))) (cadr (cdr (assoc 10 ll1))))
       ca2 (list (car (cdr (assoc 11 ll1))) (cadr (cdr (assoc 11 ll1))))
       per 0
       i2 0
    )
    ;Вложеный цикл------2--------
    (while (< i2 (sslength lines))
      (if (not (= i1 i2))
    (progn      
          (setq ll2 (entget (ssname lines i2)))
          (setq 
            ca3 (list (car (cdr (assoc 10 ll2))) (cadr (cdr (assoc 10 ll2))))
            ca4 (list (car (cdr (assoc 11 ll2))) (cadr (cdr (assoc 11 ll2))))
        per 0
          )
          ;Поиск свободного конца
          ;(setq ds 0)
          (if (not (null (inters ca1 (list (+ (car ca1) 10) (+ (cadr ca1) 10)) ca3 ca4)))
        (progn
          (setq per 2
                i2 (+ (sslength lines) 1)
          )
        )
          )
          (if (not (null (inters (list (+ (car ca2) 10) (+ (cadr ca2) 10)) ca2 ca3 ca4)))
        (progn
          (setq per 1
                i2 (+ (sslength lines) 1)
          )
        )
      )     
        ) ; конец progn - 2
      ) ; конец if - 2
      
      (setq i2 (1+ i2))
    )

    (if (= per 1)
      (dif ca1)
    )
    (if (= per 2)
      (dif ca2)
    )
    (setq i1 (1+ i1))
  )
  
)

и код на отрисовку треугольника:

Код:

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

 ;;Ставит метку, согласно ориентации
(defun dif(pt / ca1 ca2 a b c d)
 ;(setvar "OSMODE" 0)
 (command "_.layer" "_set" "ventline1" "")
 (setq ll (entget (ssname (ssget pt) 0)))
 (setq 
       ca1 (list (car (cdr (assoc 10 ll))) (cadr (cdr (assoc 10 ll))))
       ca2 (list (car (cdr (assoc 11 ll))) (cadr (cdr (assoc 11 ll))))
 )
  (setq
        a (list (- (car pt) 30) (+ (cadr pt) 30))
        b (list (+ (car pt) 30) (+ (cadr pt) 30))
        c (list (+ (car pt) 30) (- (cadr pt) 30))
        d (list (- (car pt) 30) (- (cadr pt) 30))
  )
 (if (null (inters ca1 ca2 a b))
  (if (null (inters ca1 ca2 b c))
   (if (null (inters ca1 ca2 c d))
    (if (null (inters ca1 ca2 d a))
      (setq ugl nil)
      (setq ugl 9)
    )
    (setq ugl 6) 
   )
   (setq ugl 3) 
  )
  (setq ugl 12)
 )
 (if (= ugl 12)
  (command "_pline" pt (list (+ (car pt) 30) (cadr pt)) (list (car pt) (- (cadr pt) 30)) (list (- (car pt) 30) (cadr pt)) pt "")
  (if (= ugl 3)
   (command "_pline" pt (list (car pt) (+ (cadr pt) 30)) (list (- (car pt) 30) (cadr pt)) (list (car pt) (- (cadr pt) 30)) pt "")
   (if (= ugl 6)
    (command "_pline" pt (list (+ (car pt) 30) (cadr pt)) (list (car pt) (+ (cadr pt) 30)) (list (- (car pt) 30) (cadr pt)) pt "")
    (if (= ugl 9)
     (command "_pline" pt (list (car pt) (+ (cadr pt) 30)) (list (+ (car pt) 30) (cadr pt)) (list (car pt) (- (cadr pt) 30)) pt "")
    )
   )
  )
 )
)

Помогите, пожалуйста, избавится от отрисовки лишних меток.

ЗЫ не ругайте сильно за код, я всего полторы недели изучаю LISP.
Что б не возникло вопроса, "зачем, тебе это?" отвечу сразу, это моя дипломная работа. Автоматизация проектирования вентиляции. Поэтому если будет коды каких-то готовых решений, буду благодарен.

ЗЫ нашёл решение проблемы!!! пошёл по золотому правилу программиста, "не можешь найти ошибку, перепиши код".

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

Код:

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

 (defun c:dall ()
  (command "_.layer" "_set" "ventline" "")
  (setq layer (cons 8 "ventline")
        lines (ssget "_x" (list '(0 . "LINE") layer))
        i1 0
  )
  (while (< i1 (sslength lines))
    (setq ll1 (entget (ssname lines i1)))
    (setq 
       ca1 (list (car (cdr (assoc 10 ll1))) (cadr (cdr (assoc 10 ll1))))
       ca2 (list (car (cdr (assoc 11 ll1))) (cadr (cdr (assoc 11 ll1))))
       i2 0
       kol21 0
       kol22 0
    )
    ;; Вложеный цикл ---2--- начало
    (while (< i2 (sslength lines))
      (setq ll2 (entget (ssname lines i2)))
      (setq 
            ca3 (list (car (cdr (assoc 10 ll2))) (cadr (cdr (assoc 10 ll2))))
            ca4 (list (car (cdr (assoc 11 ll2))) (cadr (cdr (assoc 11 ll2))))
      )
      (if (equal (+ (distance ca1 ca3) (distance ca1 ca4)) (distance ca3 ca4) 1e-6)
    (setq kol21 (1+ kol21))
      )
      (if (equal (+ (distance ca2 ca3) (distance ca2 ca4)) (distance ca3 ca4) 1e-6)
    (setq kol22 (1+ kol22))
      )
      (setq i2 (1+ i2))
    )
    ;; Вложеный цикл ---2--- конец
    (if (< kol21 2)
      (dif ca1)
    )
    (if (< kol22 2)
      (dif ca2)
    )
    (setq i1 (1+ i1))
  )
)

[Олег (jr.)]

Работает классно

+++++

~'o'~

[Golem-iq]

Сообщение от Олег (jr.) Работает классно +++++ ~'o'~

Благодарю

[gomer]

А слой восстановить? И зачем его устанавливать несколько раз? Обработчик ошибок? Блок вместо полилинии?
Можно вообще так (это в качестве идеи): выбираешь одну линию... а рисует для всего дерева
И если честно, непонятно как работает алгоритм... вот ты выбираешь линии в точке, в наборе должны быть две штуки или одна, если нет пересечения, потом ты берешь первую попавшуюся линию и ищешь пересечение, отступая от точки на некоторое расстояние, есть там пересечение или нет...
По идее алгоритм должен быть такой
Перебираешь все отрезки и если есть пересечение, то есть два отрезка в наборе, то строишь прямоугольник, если один не строишь ничего, попутно нужно записывать точки в список, чтобы не было накладывающихся треугольников... как-то так

[Golem-iq]

Сообщение от gomer А слой восстановить? И зачем его устанавливать несколько раз? Обработчик ошибок? Блок вместо полилинии? Можно вообще так (это в качестве идеи): выбираешь одну линию... а рисует для всего дерева И если честно, непонятно как работает алгоритм... вот ты выбираешь линии в точке, в наборе должны быть две штуки или одна, если нет пересечения, потом ты берешь первую попавшуюся линию и ищешь пересечение, отступая от точки на некоторое расстояние, есть там пересечение или нет... По идее алгоритм должен быть такой Перебираешь все отрезки и если есть пересечение, то есть два отрезка в наборе, то строишь прямоугольник, если один не строишь ничего, попутно нужно записывать точки в список, чтобы не было накладывающихся треугольников... как-то так

* Обработчики ошибок я ещё не научился писать ) поэтому идём от идеальных условий. Я программист С++ и мне довольно сложно прыгать с языка на язык (помимо диплома, так же надо выполнять лабораторные работы). Но в будущем я этим обязательно займусь.
* "Блок вместо полилинии?" Если я правильно понял это про выбор. Это часть работы по вентиляции поэтому мне нужно, что бы чертёж был из отрезков (это участки воздуховода).
* Отрисовка для всех линий лежащих в слое ventline. Мне нужно максимально автоматизировать процесс расчёта вентиляции, поэтому от пользователя стараюсь получать минимум действий ))
* Если посмотреть на первый вариант поиска, там я как раз пошёл по пути поиска пересечений. И зашёл в тупик... По хорошему туда ещё один вложенный цикл нужен на поиск пересечения с другой стороны линии. 2 дня я мучился с этим способом... И решил переписать.
Алгоритм:
все элементы в слое ventline заносим в набор lines
перебираем поочерёдно все элементы в этом массиве
у каждого элемента (линии) берём координаты начальной и конечной точки
для каждой из это точки организуем цикл проверки (сколько раз она принадлежит линиям на слое vent)
0 - не может быть (минимум лежит на своём отрезке)
1 - лежит только на одном отрезке
2 - точка на стыке двух линий
и так далее )
и в конце отрисовываем нужную фигуру в точке где <2 (фактически 1)

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

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

ЗЫ Забыл сказать, отрисовка метки (треугольника) работает только с отключённой привязкой. Пока не дошли руки, В будущем добавлю.

[Олег (jr.)]

Сообщение от Golem-iq * Обработчики ошибок я ещё не научился писать )

Скачай отсюда
http://www.lukewarmcoffee.com/cad/AU...Now%20What.pdf

~'o'~

[Golem-iq]

Сообщение от Олег (jr.) Скачай отсюда http://www.lukewarmcoffee.com/cad/AU...Now%20What.pdf ~'o'~

Благодарю!!! Вот это вещь! )))

[gomer]

собрано когда приложений много, то сделать лучше общую обработки ошибок функцию и *error* назначать во время программы выполнения с возвращением последующим... лучше еще прописать это дело все в фунцииях типа start_cmd и end_cmd

[Golem-iq]

Сообщение от gomer собрано когда приложений много, то сделать лучше общую обработки ошибок функцию и *error* назначать во время программы выполнения с возвращением последующим... лучше еще прописать это дело все в фунцииях типа start_cmd и end_cmd

на start_cmd и end_cmd поиск выдал две темы:

http://forum.dwg.ru/showthread.php?t=57484&page=18
http://forum.dwg.ru/showthread.php?t=7185

Это то? ) если нет, не могли бы дать ссылку?

[VVA]

Здесь еще много интересного

[gomer]

Сообщение от Golem-iq Это то? ) если нет, не могли бы дать ссылку?

Это как start_dialog и unload_dialog надеюсь вы понимаете о чем я говорю... вчитайтесь в название функций, вы же программист
Вы создаете команду, значит она как-то начинается, а также непременно заканчивается. Многие команды начинаются и заканчиваются одинаково: сохраняются переменные, создаются слои, стили... и т.д.
Затем диалог с пользователем, потом отрисовка... и в конце концов нужно вернуть системные переменные в исходное состояние, удалить временные слои...
если происходит прерывание, то программа не дойдет до конца... следовательно в обработчике ошибок нужно дублировать завершающие шаги... чтобы не писать код 2 раза, создается функция end_cmd (название неважно, важна суть) ну и соответственно аналогичная функция добавляется в начало команды
Это довольно трудоемко вроде-бы... но когда вы пишите вторую функцию, то вам уже не надо ни о чем беспокоиться

Код:

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

 (defun c:mycmd ()
  (start_cmd)
;;; тут ваш код
  (end_cmd))

и вы уже уверенны в том, что программа сработает корректно

[Golem-iq]

Сообщение от VVA Здесь еще много интересного

Благодарю! Кстати именно одна из ваших тем помогла мне найти второй, а главное правильный, путь )

Для gomer:
Я представил себе для чего это может понадобиться и совершенно с Вами согласен, благодарю за помощь ) За сегодняшний день узнал для себя много нового

[VVA]

Сообщение от Golem-iq Я представил себе для чего это может понадобиться

Пример опять же с сайта Lee Mac

[Golem-iq]

Сообщение от VVA Пример опять же с сайта Lee Mac

Благодарю за пример. Примерно о такой логике и подумал ) Наконец-то будут 5 дней выходных, которые я смогу посвятить лиспу. Как раз буду разбирать ссылки )

VVA, я очень много бродил по поиску и посетил не одну сотню тем. И в 95% случаев там есть ваше участие: совет дать, листинг кода привести или даже просто направить на правильный путь мыслей. Я честно говоря поражён. Очень приятно видеть, что есть ещё люди, которые действительно готовы помогать окружающим.

[_REGEN]

Сообщение от Golem-iq VVA

Сообщение от Golem-iq Очень приятно видеть, что есть ещё люди, которые действительно готовы помогать окружающим.

5+++

[gomer]

когда учишь кого-то, учишься сам, новое поколение приходит со светлой головой, не заштампованное и полное идей и без него старое просто варится в собственном соку
Это рекурсия нашей жизни

[Golem-iq]

Сообщение от gomer когда учишь кого-то, учишься сам, новое поколение приходит со светлой головой, не заштампованное и полное идей и без него старое просто варится в собственном соку Это рекурсия нашей жизни

Согласен с Вами )