dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

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

Лисп для подсчета количества пересечений отрезков

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 18.03.2018, 00:53 #1
Лисп для подсчета количества пересечений отрезков
posetitel
 
Регистрация: 16.10.2013
Сообщений: 150

posetitel вне форума Вставить имя

Добрый день!
Есть ли такой лисп, который показывает количество пересечений отрезков, полилиний друг с другом (отрезок с отрезком, отрезок с полилинией, полилиния с полилинией)?
В основном сумму длин все ищут, а вот пересечений вроде никто не выкладывал еще.
Просмотров: 1438
 
Непрочитано 18.03.2018, 07:54
#2
trir


 
Регистрация: 18.12.2010
Сообщений: 2,744


на лисп'е это делать - плохая идея
trir вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 18.03.2018, 09:55
#3
maratovich


 
Регистрация: 12.07.2009
г. Самара
Сообщений: 2,201
Отправить сообщение для maratovich с помощью Skype™


Сделать можно всё что угодно, но на это нужно затратить много времени...
1. Приложите файл примера.
2. Опишите точно что вам нужно.
3. Приложите Ваш код и укажите где у вас появляются проблемы. Ветка создана для помощи по доработке кода.
4. Если у Вас нет кода, но Вам это очень надо, то в ветке "Поиск исполнителей" вам смогут помочь.
Offtop: (рассуждайте логично - если к вам подойдёт дядя с улицы и попросит сделать его работу просто так, вы будете это делать ?)
__________________
Вопрос : Где находится Тургай ? Ответ : Между Парагваем и Уругваем.....
maratovich вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 18.03.2018, 10:01
#4
trir


 
Регистрация: 18.12.2010
Сообщений: 2,744


или можно взять мой код и немножко его допилить
trir вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 18.03.2018, 10:17
#5
posetitel


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


в кодах ничего не понимаю, могу только скопировать, подгрузить лисп и запустить код. если можно иначе как-то, то тоже хорошо, я просто не знаком с иными методами.
задача для понимания весьма простая - есть горизонтальные и вертикальные отрезки и полилинии, нужно пересчитать сколько раз они пересекаются, дальше это будет количество вязок арматуры, например, и задание смежникам.
(вариант умножить одно на другое в ручную не предлагать, не прокатит)
posetitel вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 18.03.2018, 11:08
#6
VVA

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


Цитата:
Сообщение от posetitel Посмотреть сообщение
нужно пересчитать сколько раз они пересекаются, дальше это будет количество вязок арматуры, например, и задание смежникам.
Другой вариант. Расстановка в пересечения отрезков и полилиний блоков с именем "Вязка арматуры". Подсчет блоков - выдача заданий смежникам
Lisp. Расстановка блоков на пересечении линий.
Insert block at intersection
Insert Blocks on intersection lines then break/trim
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 18.03.2018, 11:17
#7
posetitel


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


первая ссылка - оно.
спасибо.
предполагал, что задача вполне тривиальная и часто требующаяся, только вот поиск так и не дал результата.
posetitel вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 18.03.2018, 17:16
#8
rebus


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


Вариант 1:
Код:
[Выделить все]
 ; -*- coding: cp1251-dos -*-

(defun C:count-intersections (/ e en i sel lst lst2 cnt tm)
  ; Get selection
  (setq sel (ssget))
  ; Convert selection set to list and filter
  (setq i 0 lst '())
  (repeat (sslength sel)
          (setq e (ssname sel i))
          (setq en (cdr (assoc 0 (entget e))))
          (if (member en '("LWPOLYLINE" "LINE"))
              (setq lst (cons (vlax-ename->vla-object e)
                              lst)))
          (setq i (1+ i)))
  ; Count intersections
  (setq cnt 0)
  (while lst (setq en (car lst)
                   lst2 (cdr lst))
         (foreach i lst2 (setq tm (vlax-variant-value (vla-intersectwith en i acExtendNone)))
                  (setq e (vlax-safearray-get-u-bound tm 1))
                  (if (>= e 0)
                      (setq cnt (+ cnt (/ (1+ e)
                                          3)))))
         (setq lst (cdr lst)))
  (princ "Найдено пересечений: ")
  (princ cnt)
  (princ))
Вариант 2:
Код:
[Выделить все]
 ; -*- coding: cp1251-dos -*-

(defun C:count-intersections (/ e e2 i sel lst lst2 cnt tm)
  ; Select LINEs and LWPOLYLINEs only
  (setq sel (ssget '((-4 . "<OR")
                     (0 . "LINE")
                     (0 . "LWPOLYLINE")
                     (-4 . "OR>"))))
  ; Convert selection set to list
  (setq i 0 lst '())
  (repeat (sslength sel)
          (setq lst (cons (vlax-ename->vla-object (ssname sel i))))
          (setq i (1+ i)))
  ; Count intersections
  (setq cnt 0)
  (while lst (setq e2 (car lst)
                   lst2 (cdr lst))
         (foreach i lst2 (setq tm (vlax-variant-value (vla-intersectwith e2 i acExtendNone)))
                  (setq e (vlax-safearray-get-u-bound tm 1))
                  (if (>= e 0)
                      (setq cnt (+ cnt (/ (1+ e)
                                          3)))))
         (setq lst (cdr lst)))
  (princ "Найдено пересечений: ")
  (princ cnt)
  (princ))
Не знаю, какой лучше. Работают одинаково, разница в том, что второй вариант подавляет выбор примитивов кроме отрезков и полилиний.

Последний раз редактировалось rebus, 18.03.2018 в 18:07. Причина: Раз'tab'ил отступы
rebus вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 18.03.2018, 19:55
#9
posetitel


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


rebus, спасибо
posetitel вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 05.04.2018, 10:34
#10
posetitel


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


VVA, а можно доработать лисп по второй ссылке (вот он)
Цитата:
(defun c:sbx ( / )
(progn
(setq ent (car (entsel "\nSelect main line: ")))
(if ent
(progn
(princ "\nSelect crossing line(s): ")
(if (setq ss (ssget))
(progn
(setq count 0
obj (vlax-ename->vla-object ent)
pointlist nil
)
(repeat (sslength ss)
(setq xent (ssname ss count)
xobj (vlax-ename->vla-object xent)
)
(if (setq int (vla-IntersectWith obj xobj acExtendNone))
(progn
(setq int (vlax-safearray->list (vlax-variant-value int))
pointlist (append pointlist (list int))
)
)
)
(setq count (1+ count))
)
(if (null (tblobjname "BLOCK" "SBblock"))
(progn
(entmake (list (cons 0 "BLOCK") (cons 2 "SBblock") (cons 70 0) (list 10 0.0 0.0 0.0)))
(entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (8 . "0") (100 . "AcDbPolyline") (90 . 2) (70 . 1) (43 . 1.0) (38 . 0.0) (39 . 0.0)
(10 2.5 0.0) (40 . 1.0) (41 . 1.0) (42 . 1.0) (91 . 0)
(10 -2.5 0.0) (40 . 1.0) (41 . 1.0) (42 . 1.0) (91 . 0)
(210 0.0 0.0 1.0)
)
)
(setq blockname (entmake '((0 . "ENDBLK"))))
)
)
(foreach pt_nth pointlist
(entmake (append
'((0 . "INSERT") (100 . "AcDbEntity") (8 . "0") (100 . "AcDbBlockReference") (2 . "SBblock"))
(list (cons 10 pt_nth))
'((41 . 1.0) (42 . 1.0) (43 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 0.0 0.0 1.0))
)
)
)
)
)
)
)
)
(princ)
)
чтобы перед вставкой необходимо было ввести имя вставляемого блока и блок вставлялся в слой пересекаемых основную линий
posetitel вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 06.04.2018, 15:10
#11
VVA

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


posetitel, Можно
Код:
[Выделить все]
(defun c:sbx (/ ent ss count xobj pointlist int blockname blk)
(vl-load-com)
  (if (and
        (setq blk (mydcl "Select block" (acad_strlsort (tablelist "BLOCK"))))
        (setq ent (car (entsel "\nSelect main line: ")))
        )
    (progn
      (princ "\nSelect crossing line(s): ")
      (if (setq ss (ssget))
        (progn
          (setq count     0
                obj       (vlax-ename->vla-object ent)
                pointlist nil
          ) ;_ end of setq
          (repeat (sslength ss)
            (setq xent (ssname ss count)
                  xobj (vlax-ename->vla-object xent)
            ) ;_ end of setq
            (if (setq int (vla-intersectwith obj xobj acextendnone))
              (progn
                (setq int (vlax-safearray->list (vlax-variant-value int))
                      pointlist (append
                                  pointlist
                                  (list (list int (vla-get-layer xobj)))
                                ) ;_ end of append
                ) ;_ end of setq
              ) ;_ end of progn
            ) ;_ end of if
            (setq count (1+ count))
          ) ;_ end of repeat
        ) ;_ end of progn
      ) ;_ end of if
      (foreach pt_nth pointlist
        (entmake (append
                   '((0 . "INSERT") (100 . "AcDbEntity"))
                   (list (cons 8 (cadr pt_nth)))
                   (list (cons 100 "AcDbBlockReference"))
                   (list (cons 2 blk))
                   (list (cons 10 (car pt_nth)))
                   '((41 . 1.0)
                     (42 . 1.0)
                     (43 . 1.0)
                     (50 . 0.0)
                     (70 . 0)
                     (71 . 0)
                     (44 . 0.0)
                     (45 . 0.0)
                     (210 0.0 0.0 1.0)
                    )
                 ) ;_ end of append
        ) ;_ end of entmake
      ) ;_ end of foreach
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
(defun mydcl (zagl info-list / fl ret dcl_id)
;;;Use
;;;(mydcl "Test" '("1" "2" "3" "4"))
  (vl-load-com)
  (if (null zagl)
    (setq zagl "Выбор")
  ) ;_ end of if
  (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
  (setq ret (open fl "w"))
  (mapcar
    '(lambda (x) (write-line x ret))
    (list "mip_msg : dialog { "
          (strcat "label=\"" zagl "\";")
          " :list_box {"
          "alignment=top ;"
          "width=51 ;"
          "allow_accept = true;"
          "tabs = \"16 32\";"
          "tab_truncate = true;"
          (if (> (length info-list) 26)
            "height= 26 ;"
            (strcat "height= " (itoa (+ 3 (length info-list))) ";")
          ) ;_ end of if
          "is_tab_stop = false ;"
          "key = \"info\";}"
          "ok_cancel;}"
    ) ;_ end of list
  ) ;_ end of mapcar
  (setq ret (close ret))
  (if (and (not (minusp (setq dcl_id (load_dialog fl))))
           (new_dialog "mip_msg" dcl_id)
      ) ;_ end of and
    (progn
      (start_list "info")
      (mapcar 'add_list info-list)
      (end_list)
      (set_tile "info" "0")
      (setq ret (car info-list))
      (action_tile
        "info"
        "(setq ret (nth (atoi $value) info-list))"
      ) ;_ end of action_tile
      (action_tile
        "cancel"
        "(progn(setq ret nil)(done_dialog 0))"
      ) ;_ end of action_tile
      (action_tile "accept" "(done_dialog 1)")
      (start_dialog)
    ) ;_ end of progn
  ) ;_ end of if
  (unload_dialog dcl_id)
  (vl-file-delete fl)
  ret
) ;_ end of defun
;;;================================================================================
;;;Written By Michael Puckett. 
;;;Список элементов символьных таблиц АвтоКАДа 
;;; - s- имя таблицы
;;;Пример - список всех слоев - (setq all_layers (tablelist "LAYER"))
;;;(setq all_layers (tablelist "LAYER"))
;;;Start Coding Here 
(defun tablelist (s / d r)
  (while (setq d (tblnext s (null d)))
    (setq r (cons (cdr (assoc 2 d)) r))
  ) ;_ while
) ;_ defun
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 07.04.2018 в 09:27.
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 06.04.2018, 15:43
#12
posetitel


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


большое человеческое спасибо
posetitel вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Лисп для подсчета количества пересечений отрезков

НАНОКАД 10 лет
Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как сосчитать сумму цифр из отдельных мтекстов (и лисп для подсчета спецификаций) Red Nova LISP 644 24.05.2016 08:11
Объединение большого количества отрезков Мансур Программирование 25 07.07.2014 18:35
Ведомость подсчета количества конструкций, изделий и материалов Diaz Технология и организация строительства 1 12.05.2012 13:32
Мембранная кровля - особенности подсчета количества крепежа ETCartman Конструкции зданий и сооружений 10 22.09.2009 00:13
ЛИСП для подсчета количества приметивов? dextron3 LISP 18 18.06.2007 16:54

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||