Нахождение расстояния между точками на чертеже

Макс_Кунгур · 23.08.2010, 09:03

Добрый день! Столкнулся с такой задачей. Есть чертеж с множеством точек (около 100). Нужно при помощи языка LISP найти расстояния от одной точки, которую ты укажешь на чертеже, до всех остальных точек. Результат с расстояниями должен вывестись в текстовый файл или в таблицу Excel.
Как найти расстояние между 2-мя точками, я знаю. А вот как до всех точек, пока не разобрался. Подскажите, пожалуйста, как решить данную задачу.

Profan · 23.08.2010, 09:35

Для начала их бы (точки) пронумеровать...

Макс_Кунгур · 23.08.2010, 10:33

Profan, в Point Group Manager они есть, импортированы с координатами и номерами.
Как я понимаю, мне нужно все оставшиеся точки объединить в набор. Во-первых, я не знаю как это сделать, а во-вторых, что с этим набором дальше делать?

Дима_ · 23.08.2010, 10:35

Цитата:

Сообщение от Макс_Кунгур

Как найти расстояние между 2-мя точками, я знаю.

Соберите все осальные точки в список и прогоните через функцию вычисления расстояния. Аналогично с выводом результата.

Макс_Кунгур · 23.08.2010, 10:39

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

Дима_ · 23.08.2010, 10:43

как вариант:
а- ваша превая точка
(mapcar '(lambda (x) (тело функции считающие расстояние от а до х))
(список точек))

Олег (jr.) · 23.08.2010, 10:45

Цитата:

Сообщение от Макс_Кунгур

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

Можно просто записать в файл CSV а потом в меню
Данные --> Разбить по столбцам:

Код:

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

(defun c:pex(/ *error* counter dest dist_info elist filedesc filename n p pent prec pset ptsset)
  
  (defun *error* (msg)
    (if msg (princ msg)
      (princ "\nError")
      )
    (if filedesc (close filedesc))
    (prin1)
    )
  
  (if
    (setq pset (ssget "_+.:S:E" (list (cons 0 "POINT"))))
     (progn
       (setq pent (ssname pset 0))
       (setq dest (cdr (assoc 10 (entget pent))))
       (command "._zoom" "_e")
       (setq ptsset (ssget "_X" (list (cons 0 "POINT"))))
       (command "._zoom" "_p")
       (ssdel pent ptsset)
       (setq dist_info
	      (mapcar '(lambda (p) (distance p dest))
		      (mapcar '(lambda (elist)
				 (cdr (assoc 10 elist)))
			      (mapcar 'entget
				      (vl-remove-if
					'listp
					(mapcar 'cadr (ssnamex ptsset)))))))
       (setq dist_info (mapcar '(lambda	(n)
				  (nth n dist_info))
			       (vl-sort-i dist_info '(lambda (x y) (< x y)))))

       (setq filename (strcat (getvar "dwgprefix")
			      (vl-filename-base (getvar "dwgname"))
			      ".csv"))
       (setq filedesc (open filename "w"))
       (setq counter 1
	     prec    (getvar "dimdec"))
       (foreach	item  dist_info
	 (write-line
	   (strcat (itoa counter) (chr 9) (rtos item 2 prec))
	   filedesc)
	 (setq counter (1+ counter)))
       (close filedesc)
       )
     )
    (princ)
    )
(princ "\nStart command with PEX ...")
(prin1)

Нумерация точек в файле по взрастанию расстояния

~'J'~

Макс_Кунгур · 23.08.2010, 11:23

Олег (jr.), потестировал твой лисп. Вот что в командной строке написано:
Command: _appload DISTANCE_F.LSP successfully loaded.
Command:

Start command with PEX ...
Command:

Command: pex

Select objects:

Command:
Как я понимаю, когда я выбрал точку, программа оборвалась.
И куда этот файл .csv записывается?

Олег (jr.) · 23.08.2010, 11:46

Цитата:

Сообщение от Макс_Кунгур

Олег (jr.), потестировал твой лисп. Вот что в командной строке написано:
Command: _appload DISTANCE_F.LSP successfully loaded.
Command:

Start command with PEX ...
Command:

Command: pex

Select objects:

Command:
Как я понимаю, когда я выбрал точку, программа оборвалась.
И куда этот файл .csv записывается?

Ищи в той же папке под названием "ИмяЧертежа.csv"

~'J'~

Макс_Кунгур · 23.08.2010, 12:44

Олег (jr.), там ничего нет. Как я говорил раньше, наверное, программа обрывается, когда я выбираю примитив. Из-за чего?

Олег (jr.) · 23.08.2010, 14:33

Цитата:

Сообщение от Макс_Кунгур

Олег (jr.), там ничего нет. Как я говорил раньше, наверное, программа обрывается, когда я выбираю примитив. Из-за чего?

Все правильно, программа работает быстро и не видно изменений
на экране
У меня просто есть сомнение насчет того что выбранная точка является примитивом типа Point
Добавим информативности:

Код:

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

;;pex.lsp
(defun c:pex(/ *error* counter dest dist_info elist filedesc filename n p pent prec pset ptsset)
  
 (defun *error* (msg)
 (if msg
 (if 
 (or 
 (= msg "Function cancelled")
 (= msg "quit / exit abort") 
 )
 (princ)
 (princ  (strcat "\nError message: " msg))
)
)
    (if filedesc (close filedesc))
    (princ)
    )

  
  (if   
    (setq pset (ssget "_+.:S:E" (list (cons 0 "POINT"))))

     (progn
       
       (setq pent (ssname pset 0))
       (setq dest (cdr (assoc 10 (entget pent))))
       (command "._zoom" "_e")
       (setq ptsset (ssget "_X" (list (cons 0 "POINT"))))
       (alert (strcat "Totally selected " (itoa (sslength ptsset)) " points"))
       (command "._zoom" "_p")
       (ssdel pent ptsset)
       (setq dist_info
	      (mapcar '(lambda (p) (distance p dest))
		      (mapcar '(lambda (elist)
				 (cdr (assoc 10 elist)))
			      (mapcar 'entget
				      (vl-remove-if
					'listp
					(mapcar 'cadr (ssnamex ptsset)))))))
       (setq dist_info (mapcar '(lambda	(n)
				  (nth n dist_info))
			       (vl-sort-i dist_info '(lambda (x y) (< x y)))))

       (setq filename (strcat (getvar "dwgprefix")
			      (vl-filename-base (getvar "dwgname"))
			      ".csv"))
       (setq filedesc (open filename "w"))
       (setq counter 1
	     prec    (getvar "dimdec"))
       (foreach	item  dist_info
	 (write-line
	   (strcat (itoa counter) (chr 9) (rtos item 2 prec))
	   filedesc)
	 (setq counter (1+ counter)))
       (close filedesc)

       (alert (strcat "File created with pat:\n" filename))
       )

    (alert (strcat "Selected object is not a POINT entity"))

     )

    (princ)
    )
(princ "\nStart command with PEX ...")
(prin1)

~'J'~

Макс_Кунгур · 24.08.2010, 13:34

Олег (jr.), спасибо. Все получилось, как надо. Я поменял строчку добавления в набор и заработало. Еще раз спасибо. Скажи, пожалуйста, а можно сделать так, чтобы точку не выбирать, с которой нужно считать значения, а при запуске лиспа, программа считала расстояния сначала от одной точки до всех оставшихся точек, потом от второй, и т.д., пока не дойдет до последней точки. А результаты бы выводились в один файл, но в разные таблицы. И еще, у меня у каждой точки стоит свой номер. Можно сделать так, чтобы в результирующий файл попадали значения расстояний с обозначением:
№ 35 - № 10Э06 15
№ 35 - № 11Э06 25
.......................
№ 35 - № n d

Олег (jr.) · 24.08.2010, 14:31

Цитата:

Сообщение от Макс_Кунгур

Олег (jr.), спасибо. Все получилось, как надо. Я поменял строчку добавления в набор и заработало. Еще раз спасибо. Скажи, пожалуйста, а можно сделать так, чтобы точку не выбирать, с которой нужно считать значения, а при запуске лиспа, программа считала расстояния сначала от одной точки до всех оставшихся точек, потом от второй, и т.д., пока не дойдет до последней точки. А результаты бы выводились в один файл, но в разные таблицы. И еще, у меня у каждой точки стоит свой номер. Можно сделать так, чтобы в результирующий файл попадали значения расстояний с обозначением:
№ 35 - № 10Э06 15
№ 35 - № 11Э06 25
.......................
№ 35 - № n d

Чертеж в студию (пож-ста не выше 2008)
+ объяснения в чертеж в виде мтехта

~'J'~

Макс_Кунгур · 24.08.2010, 15:34

Чертеж не могу скинуть, потому что он у меня в проекте. Скидываю рисунок DIST. Эти точки импортированы с текстового файла с разделителями табуляции. В текстовом файле содержалось:
1 столбец - номер строки, 2 столбец - координата по X, 3 столбец - координата по Y, 4 столбец - координата по Z, 5 столбец - название (номер точки).
Что нужно: загружаем лисп, вводим PEX, результат:
Файл .csv, или можно много файлов .csv (по количеству точек), в котором должно быть всего 2 столбца: 1 ст. - название расстояния (например, r 1-2, r 1-3,....r 2-1, r 2-3,...r 3-1, r 3-2,....),Т.Е. ПО НОМЕРУ ТОЧЕК, чтобы не перепутать; 2 ст. - значение расстояния.
Вот вроде бы все.

Кулик Алексей aka kpblc · 24.08.2010, 15:39

Рисунок ничем не поможет. Надо смотреть на внутренности dwg.

Олег (jr.) · 24.08.2010, 15:44

Цитата:

Сообщение от Макс_Кунгур

Чертеж не могу скинуть, потому что он у меня в проекте. Скидываю рисунок DIST. Эти точки импортированы с текстового файла с разделителями табуляции. В текстовом файле содержалось:
1 столбец - номер строки, 2 столбец - координата по X, 3 столбец - координата по Y, 4 столбец - координата по Z, 5 столбец - название (номер точки).
Что нужно: загружаем лисп, вводим PEX, результат:
Файл .csv, или можно много файлов .csv (по количеству точек), в котором должно быть всего 2 столбца: 1 ст. - название расстояния (например, r 1-2, r 1-3,....r 2-1, r 2-3,...r 3-1, r 3-2,....),Т.Е. ПО НОМЕРУ ТОЧЕК, чтобы не перепутать; 2 ст. - значение расстояния.
Вот вроде бы все.

Если тебе трудно скопировать десяток этих точек и вставить в пустой чертеж
то почему я должен писать эту фигню чтобы потом все переделывать?
или ты думаешь что это прошу только из-за моей прихоти?
А где расстояние от точек до текста, а как расположен текст относительно точек,
а на каком слое и то и другое?
Ну и мне это надо?

CB · 24.08.2010, 15:50

Цитата:

Эти точки импортированы с текстового файла

Так а нафига тогда вообще чертеж dwg, если можно проанализировать текстовый файл?

Дима_ · 24.08.2010, 15:55

Цитата:

Сообщение от Олег (jr.)

Если тебе трудно скопировать десяток этих точек и вставить в пустой чертеж
то почему я должен писать эту фигню чтобы потом все переделывать?
или ты думаешь что это прошу только из-за моей прихоти?
А где расстояние от точек до текста, а как расположен текст относительно точек,
а на каком слое и то и другое?
Ну и мне это надо?

Вот - что и следовало ожидать когда лисп пишется "вслепую" по устному объяснению человека. Не надо торопиться вылечить человека - вначале надобы понять что болит.
p.s. тебе еще "повезло" что точки оказались действительно точками, а расстояние - расстоянием (а, например, не проекцией на плоскость XY).
p.p.s

Цитата:

Эти точки импортированы с текстового файла

- а здесь вообще встает вопрос о правильности выбора автокада - как инструмента для выполнения задачи.

Олег (jr.) · 24.08.2010, 18:18

Цитата:

Сообщение от Дима_

Вот - что и следовало ожидать когда лисп пишется "вслепую" по устному объяснению человека. Не надо торопиться вылечить человека - вначале надобы понять что болит.
p.s. тебе еще "повезло" что точки оказались действительно точками, а расстояние - расстоянием (а, например, не проекцией на плоскость XY).
p.p.s - а здесь вообще встает вопрос о правильности выбора автокада - как инструмента для выполнения задачи.

Я просто часто на эти грабли уже наступал, не далее как пару лет
назад сделал 18 вариантов довольно большой программы
- человек тоже говорил что не может чертеж выслать с рабочего
места по корпоративным правилам, а в результате оказалось
что ему совсем не то было нужно
В результате я все же сделал как надо, на все про все месяц ушел,
а можно было за пару дней сляпать если бы чертеж был изначально под рукой

Насчет файла данных (текстовый или другой) тоже согласен,
скорее всего он тоже у Макса есть

Макс_Кунгур · 25.08.2010, 07:47

Олег (jr.), Кулик Алексей aka kpblc, выкладываю dwg.

Дима_ · 25.08.2010, 10:12

Ну тогда-уж и не поленись пример что должно получиться с этого чертежа?
з.ы. и еще раз подумай нужен-ли тебе автокад для решения этой задачи, может лучше пример исходного текстового и результата?

Кулик Алексей aka kpblc · 25.08.2010, 10:31

Может, проще будет все же воспользоваться инструментами Civil'a? Там же не точки, а объекты Civil...

Макс_Кунгур · 25.08.2010, 11:10

Дима_, выкладываю, то, что должно получиться.
Кулик Алексей aka kpblc, я не знаю, как будет проще, лишь бы работало. В дальнейшем я буду импортировать точки в этот dwg по мере их поступления, и применять данный лисп.

gomer · 25.08.2010, 11:20

А где точки?

Дима_ · 25.08.2010, 11:50

Макс ну ты прикалываешся что-ли? У тебя пример результата рисунку соответствует? В какие единицы не переводи - отношения в расстояних различается. Еще раз напоминаю - нужен-ли здесь вообще автокад - откуда эти точки полученны - не поленись тоже файл приложи. (только чтоб соответствовал).
p.s. если хочешь чтобы тебе что-то сделали не поленись объяснить, и пойми наконец что "секретные" точки твоей фирмы здесь всем по барабану, будешь урывками выкладывать это рано или поздно всех з...ет и обмерять тебе руками свои точки (или лисп учить).

Макс_Кунгур · 25.08.2010, 11:57

Выкладываю файл с точками.
Дима_, да я значения расстояний наугад написал для примера, как должно выглядеть в лучшем случае. Там должны стоять истинные расстояния между точками.

CB · 25.08.2010, 12:09

О как!
Оказывается здесь точки в пространстве, а не в плоскости...

1 484304.0 6373696.0 144.9 1Э04
2 484349.2 6373694.2 130.9 2Э04
3 484303.3 6373661.0 134.9 4Э04
4 484348.4 6373662.6 149.2 5Э04

Макс_Кунгур · 25.08.2010, 12:11

ВДима_, выкладываю файл, то что должно получиться, с реальными расстояниями и реальным расположением их в таблице (т.е. с минимальной по максимальную).

Дима_ · 25.08.2010, 12:30

Я правильно понимаю что 3 столбец (144,9 130,9 134.9 149.2) в расчетах участия не принимает?
То есть считаем расстояния только по 2 и 3 столбцу (x,y)?

Олег (jr.) · 25.08.2010, 12:55

Цитата:

Сообщение от Макс_Кунгур

ВДима_, выкладываю файл, то что должно получиться, с реальными расстояниями и реальным расположением их в таблице (т.е. с минимальной по максимальную).

Сегодня наверно не смогу даже глянуть твой файл -
срочная работа
Сделаю позже...

Макс_Кунгур · 25.08.2010, 12:56

Извините, забыл сказать, что координату z (т.е. 3-й столбец 144,9 130,9 134.9 149.2) надо ОБЯЗАТЕЛЬНО в расчеты брать!!!

Дима_ · 25.08.2010, 13:07

Так у тебяж она не считаеться (у тебя только по 2 координатам?) Точно учитывать надо? (ладно-уж расчет можешь не переделывать, скажи только он верен или нет - ихмо он по 2 сделан)

Макс_Кунгур · 25.08.2010, 13:14

Дима_, а как я смогу это проверить, если у меня этих значений расстояний нет. В том-то и дело, что мне их и нужно рассчитать и выдать результат. А когда они появятся, сверить с моими.

Дима_ · 25.08.2010, 13:37

Короче я делаю тебе прогу которая считает расстояния с учетом xyz.

Кулик Алексей aka kpblc · 25.08.2010, 13:40

Моей соображалки хватило только на такое:

Дима_ · 25.08.2010, 13:51

Смотри внимательно соблюдай формат твоего-же файла (программа его не проверяет набросал из готовых блоков - некогда мне особо), первую строку (в твоем файле она пустая) пропускает - можешь добавить там, например заголовок. Но все остальное - чтоб также (разделители табуляторы, поля по порядку). Выходной файл называй *.csv - его эксель должен "на ура" читать. Результат работы твоего-же примера в архиве. Если захочешь что-нибудь добавить-поменять 7 раз подумай - ничего не упусти - потом спроси.

Макс_Кунгур · 25.08.2010, 15:40

Дима_, спасибо. Сегодня-завтра потестирую, ответ напишу.
Кулик Алексей aka kpblc, спасибо, можно и так. Там у тебя в архиве только результат, а где сам лисп?

Олег (jr.) · 25.08.2010, 23:45

Тут делов с гулькин нос
Спробуй

Кулик Алексей aka kpblc · 25.08.2010, 23:49

Макс_Кунгур, там нет лиспа. На втором листе Excel'a просто вычисления, вот и все. ДОбавляешь точки с номерами, справа - от какой до какой точки. И получаешь расстояния.

CB · 26.08.2010, 08:59

>Олег (jr.)

Цитата:

Там же не точки, а объекты Civil...

Пробуй такой вариант. С красотой в Exel'е не заморачивался...

Код:

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

(defun dwgru-string-to-list (str delimiter / pos)
  (if (= delimiter (chr 32))
    (setq str (dwgru-string-replace
                str
                (strcat (chr 32) (chr 32))
                delimiter
              ) ;_ end of dwgru-string-replace
    ) ;_ end of setq
  ) ;_ end of if
  (if (setq pos (vl-string-search delimiter str))
    (cons
      (substr str 1 pos)
      (dwgru-string-to-list
        (substr
          str
          (+ (strlen delimiter) pos 1)
        ) ;_ end of substr
        delimiter
      ) ;_ end of ru-string-pl-string-to-list
    ) ;_ end of cons
    (cons str '())
  ) ;_ end of if
) ;_ end of defun

(defun test (/ ent lst filename file)
  (setq ent (ssget "_x" '((0 . "MTEXT"))))
  (if ent
    (progn
      (setq lst
             (mapcar
               '(lambda (el)
                  ((lambda (txt pt)
                     (cons
                       (substr (car txt) 3)
                       (mapcar '+
                               pt
                               (list 0. 0. (read (last txt)))
                       ) ;_ end of mapcar
                     ) ;_ end of cons
                   ) ;_ end of lambda
                    (dwgru-string-to-list (car el) "\\P")
                    (cdr el)
                  )
                ) ;_ end of lambda
               (vl-sort
                 (mapcar
                   '(lambda (x)
                      ((lambda (a)
                         (cons
                           (cdr (assoc 1 a))
                           (cdr (assoc 10 a))
                         ) ;_ end of cons
                       ) ;_ end of lambda
                        (entget x)
                      )
                    ) ;_ end of lambda
                   (vl-remove-if
                     'listp
                     (mapcar 'cadr (ssnamex ent))
                   ) ;_ end of vl-remove-if
                 ) ;_ end of mapcar
                 (function
                   (lambda (a b)
                     (< (car a) (car b))
                   ) ;_ end of lambda
                 ) ;_ end of function
               ) ;_ end of vl-sort
             ) ;_ end of mapcar
      ) ;_ end of setq
      (setq
        filename
         (strcat (getvar "dwgprefix")
                 (vl-filename-base (getvar "dwgname"))
                 ".csv"
         ) ;_ end of strcat
      ) ;_ end of setq
      (setq file (open filename "w"))
      (mapcar
        (function
          (lambda (l)
            (foreach i l
              (write-line
                (strcat (car i) " " (rtos (cadr i) 2 2))
                file
              ) ;_ end of write-line
            ) ;_ end of foreach
          ) ;_ end of lambda
        ) ;_ end of function
        (mapcar
          (function
            (lambda (x)
              ((lambda (txt pt)
                 (mapcar
                   '(lambda (y)
                      (list
                        (strcat "r" txt "-" (car y))
                        (distance pt (cdr y))
                      ) ;_ end of list
                    ) ;_ end of lambda
                   (vl-remove x lst)
                 ) ;_ end of mapcar
               ) ;_ end of lambda
                (car x)
                (cdr x)
              )
            ) ;_ end of lambda
          ) ;_ end of function
          lst
        ) ;_ end of mapcar
      ) ;_ end of mapcar
      (close file)
      (print (strcat "Файл " filename " успешно создан..."))
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun

Запуск - (test)

Олег (jr.) · 26.08.2010, 10:41

Цитата:

Сообщение от CB

>Олег (jr.)

Пробуй такой вариант. С красотой в Exel'е не заморачивался...

Код:

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

(defun dwgru-string-to-list (str delimiter / pos)
  (if (= delimiter (chr 32))
    (setq str (dwgru-string-replace
                str
                (strcat (chr 32) (chr 32))
                delimiter
              ) ;_ end of dwgru-string-replace
    ) ;_ end of setq
  ) ;_ end of if
  (if (setq pos (vl-string-search delimiter str))
    (cons
      (substr str 1 pos)
      (dwgru-string-to-list
        (substr
          str
          (+ (strlen delimiter) pos 1)
        ) ;_ end of substr
        delimiter
      ) ;_ end of ru-string-pl-string-to-list
    ) ;_ end of cons
    (cons str '())
  ) ;_ end of if
) ;_ end of defun

(defun test (/ ent lst filename file)
  (setq ent (ssget "_x" '((0 . "MTEXT"))))
  (if ent
    (progn
      (setq lst
             (mapcar
               '(lambda (el)
                  ((lambda (txt pt)
                     (cons
                       (substr (car txt) 3)
                       (mapcar '+
                               pt
                               (list 0. 0. (read (last txt)))
                       ) ;_ end of mapcar
                     ) ;_ end of cons
                   ) ;_ end of lambda
                    (dwgru-string-to-list (car el) "\\P")
                    (cdr el)
                  )
                ) ;_ end of lambda
               (vl-sort
                 (mapcar
                   '(lambda (x)
                      ((lambda (a)
                         (cons
                           (cdr (assoc 1 a))
                           (cdr (assoc 10 a))
                         ) ;_ end of cons
                       ) ;_ end of lambda
                        (entget x)
                      )
                    ) ;_ end of lambda
                   (vl-remove-if
                     'listp
                     (mapcar 'cadr (ssnamex ent))
                   ) ;_ end of vl-remove-if
                 ) ;_ end of mapcar
                 (function
                   (lambda (a b)
                     (< (car a) (car b))
                   ) ;_ end of lambda
                 ) ;_ end of function
               ) ;_ end of vl-sort
             ) ;_ end of mapcar
      ) ;_ end of setq
      (setq
        filename
         (strcat (getvar "dwgprefix")
                 (vl-filename-base (getvar "dwgname"))
                 ".csv"
         ) ;_ end of strcat
      ) ;_ end of setq
      (setq file (open filename "w"))
      (mapcar
        (function
          (lambda (l)
            (foreach i l
              (write-line
                (strcat (car i) " " (rtos (cadr i) 2 2))
                file
              ) ;_ end of write-line
            ) ;_ end of foreach
          ) ;_ end of lambda
        ) ;_ end of function
        (mapcar
          (function
            (lambda (x)
              ((lambda (txt pt)
                 (mapcar
                   '(lambda (y)
                      (list
                        (strcat "r" txt "-" (car y))
                        (distance pt (cdr y))
                      ) ;_ end of list
                    ) ;_ end of lambda
                   (vl-remove x lst)
                 ) ;_ end of mapcar
               ) ;_ end of lambda
                (car x)
                (cdr x)
              )
            ) ;_ end of lambda
          ) ;_ end of function
          lst
        ) ;_ end of mapcar
      ) ;_ end of mapcar
      (close file)
      (print (strcat "Файл " filename " успешно создан..."))
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun

Запуск - (test)

Нету нахрен у меня никакого Civil что есть то и хаваем.

Макс_Кунгур · 27.08.2010, 13:25

Дима_, попробовал твою программу. Вроде бы все правильно делает, но мне нужен именно лисп, чтобы я в дальнейшем разобрался в нем и мог сам добавлять в него что-нибудь или убирать.
CB, попробовал твой лисп, выдает ошибку:
Command: (test)
*Cancel*
bad argument type: numberp: {\\FTIMES
Олег (jr.), потестировал твой лисп. Все хорошо работает, только номера точек ставятся по порядку, начиная с 1. А мне нужно, чтобы номера совпадали с названием точки (1Э06, 2Э06 и т.д). Можно это сделать?

Олег (jr.) · 27.08.2010, 13:48

Цитата:

Сообщение от Макс_Кунгур

Дима_, попробовал твою программу. Вроде бы все правильно делает, но мне нужен именно лисп, чтобы я в дальнейшем разобрался в нем и мог сам добавлять в него что-нибудь или убирать.
CB, попробовал твой лисп, выдает ошибку:
Command: (test)
*Cancel*
bad argument type: numberp: {\\FTIMES
Олег (jr.), потестировал твой лисп. Все хорошо работает, только номера точек ставятся по порядку, начиная с 1. А мне нужно, чтобы номера совпадали с названием точки (1Э06, 2Э06 и т.д). Можно это сделать?

Реально нет времени для теста, один раз только прогнал
Смотри сам

Дима_ · 27.08.2010, 13:52

Цитата:

Сообщение от Макс_Кунгур

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

Ты не поверишь она на лиспе (хоть и не auto):

Код:

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

#lang scheme/gui
(define (parsing-string bt (lst '()) (btx #""))
  (if (equal? bt #"")
      (reverse (cons btx lst))
      (if (equal? (subbytes bt 0 1) #"\t")
          (parsing-string (subbytes bt 1)
                          (cons btx lst)
                          #"")
          (parsing-string (subbytes bt 1)
                          lst
                          (bytes-append btx (subbytes bt 0 1))))))
(define (distance pt1 pt2)
  (/ (round (* 100 (sqrt (+ (sqr (- (cadr pt1) (cadr pt2)))
                            (sqr (- (caddr pt1) (caddr pt2)))
                            (sqr (- (cadddr pt1) (cadddr pt2))))))) 100))

(define (bytes-join lst x)
  (if (null? lst)
      #""
      (bytes-append (car lst) x (bytes-join (cdr lst) x))))

(define f (new frame%
               [label "Test kungur"]))
(define-values (sf sb)
  (let ([p (new horizontal-panel%
                [parent f])])
    (values (new text-field%
                 [parent p]
                 [label "Исходный файл"])
            (new button%
                 [parent p]
                 [label "Обзор"]
                 [callback (lambda (a b)
                             (let ([file (get-file)])
                               (when (and file (file-exists? file))
                                 (send sf set-value (path->string file)))))]))))

(define-values (of ob)
  (let ([p (new horizontal-panel%
                [parent f])])
    (values (new text-field%
                 [parent p]
                 [label "Конечный файл"])
            (new button%
                 [parent p]
                 [label "Обзор"]
                 [callback (lambda (a b)
                             (let ([file (get-file)])
                               (when file
                                 (send of set-value (path->string file)))))]))))

(define mes (new message%
                 [parent f]
                 [label "Выбирайте файлы..."]
                 [auto-resize #t]))

(define start (new button%
                   [parent f]
                   [label "Start"]
                   [callback (lambda (a b)
                               (let ([file (send sf get-value)]
                                     [otfile (send of get-value)])
                                 (when (and (not (equal? file ""))
                                            (not (equal? otfile ""))
                                            (file-exists? file))
                                   (if (file-exists? otfile)
                                       (send mes set-label "Файл не может быть перезаписан...")
                                       (let ([data (map (lambda (str)
                                                          (list (last str)
                                                                (string->number (bytes->string/utf-8 (cadr str)))
                                                                (string->number (bytes->string/utf-8 (caddr str)))
                                                                (string->number (bytes->string/utf-8 (cadddr str)))))
                                                        (map parsing-string (cdr (file->bytes-lines file))))])
                                         (send mes set-label "Обработка файла...")
                                         (display-lines-to-file
                                          (apply map (lambda x (bytes-join x #";;"))
                                                 (map (lambda (pt1)
                                                        (filter-not
                                                         void?
                                                         (map (lambda (pt2)
                                                                (when (not (equal? pt1 pt2))
                                                                  (bytes-append (car pt1)
                                                                                #"-"
                                                                                (car pt2)
                                                                                #";"
                                                                                (string->bytes/utf-8 (number->string (distance pt1 pt2))))))
                                                              data)))
                                                      data))
                                          (send of get-value) #:separator "\r\n")
                                         (send mes set-label "Готово"))))))]))
(send f center)
(send f show #t)

Олег (jr.) · 27.08.2010, 14:06

Цитата:

Сообщение от Дима_

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

Может ему еще Shema нужно для этого учить, это ты предлагаешь?

Дима_ · 27.08.2010, 14:46

Нет. Это личный выбор каждого, тем более что "подправить" иногда и не зная языка получается.
p.s. если б я ее на VB, C# или ассемблере написал - это-ж не значит, что я его изучить предлагаю.
p.p.s если б предполагалось, что человек сам хочет написать - я б код в жизни бы не написал, еслиб только советом помог как сделать, здесь не мало народу (включая меня) которые так сами и программировать на лиспе научились - если время позволяет - в любом случае полезней с автокадом и лисп знать (ну хотя-бы ориентироваться), чем руками чертить.

CB · 27.08.2010, 16:59

Цитата:

Сообщение от Макс_Кунгур

CB, попробовал твой лисп, выдает ошибку:
Command: (test)
*Cancel*
bad argument type: numberp: {\\FTIMES

Значит тестовый чертеж, который ты выложил не соответствует реальному, т.к. {\\FTIMES явно относится к Mtext.
В тестовом примере такого нет.
Набери (entget (car (entsel))), ткни в Mtext и покажи что получилось...
Интересует первая группа.
У меня выдает следующий результат (с учетом z-координаты)
r1Э04-2Э04 47.35
r1Э04-4Э04 36.41
r1Э04-5Э04 55.73
r2Э04-1Э04 47.35
r2Э04-4Э04 56.79
r2Э04-5Э04 36.53
r4Э04-1Э04 36.41
r4Э04-2Э04 56.79
r4Э04-5Э04 47.34
r5Э04-1Э04 55.73
r5Э04-2Э04 36.53
r5Э04-4Э04 47.34

Дима_ · 27.08.2010, 17:48

То СВ у тебя нет проверки м-текста (в рисунке могут не только с точками быть но и любые другие - на них по ходу и спотыкается) - самый простой вариант - в ssget "_x" убери - пусть рамкой нужные выбирает (хорошо - еще лисп вылетел а не в данные врет).

CB · 30.08.2010, 11:51

>Дима_

Цитата:

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

Абсолютно согласен - что если в чертеже будет Mtext не имеющий отношение к точкам, то вылет программы гарантирован. Здесь же дело в другом - форматирование Mtext. Пример (см. первую группу) :

Код:

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

Command: (entget (car (entsel)))
Select object: ((-1 . <Entity name: 400725a0>) (0 . "MTEXT") (330 . <Entity 
name: 40070cf8>) (5 . "224") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . 
"0") (100 . "AcDbMText") (10 484304.0 6.3737e+006 0.0) (40 . 2.0) (41 . 0.0) 
(71 . 4) (72 . 5) (1 . "№ 1Э04\\P\\P144.9") (7 . "Standard") (210 0.0 0.0 1.0) 
(11 1.0 0.0 0.0) (42 . 10.0) (43 . 8.66667) (50 . 0.0) (73 . 1) (44 . 1.0))

Command: (entget (car (entsel)))
Select object: ((-1 . <Entity name: 400725a0>) (0 . "MTEXT") (330 . <Entity 
name: 40070cf8>) (5 . "224") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . 
"0") (100 . "AcDbMText") (10 484304.0 6.3737e+006 0.0) (40 . 2.0) (41 . 0.0) 
(71 . 4) (72 . 5) (1 . "{\\fTxt|b0|i0|c204|p2;\\U+2116 
1Э04\\P\\P\\fArial|b0|i0|c0|p34;144.9}") (7 . "Standard") (210 0.0 0.0 1.0) (11 
1.0 0.0 0.0) (42 . 9.88339) (43 . 8.7754) (50 . 0.0) (73 . 1) (44 . 1.0))

Т.к. в чертеже нет объектов типа POINT, а есть

Код:

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

Command: (entget (car (entsel)))
Select object: ((-1 . <Entity name: 400945a8>) (0 . "ACAD_PROXY_ENTITY") (330 . 
<Entity name: 40091cf8>) (5 . "225") (100 . "AcDbEntity") (67 . 0) (410 . 
"Model") (8 . "PTS_UP"))

до точки вставки которого лично мне не удалось добраться, программа ищет Mtext, с точкой вставки объекта (0 . "ACAD_PROXY_ENTITY").

>Макс_Кунгур
Пробуй такой вариант:

Код:

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

(defun dwgru-string-replace
       (string old_substr new_substr / pos)
  (while (setq pos (vl-string-search old_substr string))
    (setq string
           (strcat
             (substr string 1 pos)
             new_substr
             (dwgru-string-replace
               (substr string (+ (strlen old_substr) pos 1))
               old_substr
               new_substr
             ) ;_ end of ru-string-replace
           ) ;_ end of strcat
    ) ;_ end of setq
  ) ;_ end of while
  string
) ;_ end of defun

;;;----------------------------------------------------
(defun dwgru-string-to-list (str delimiter / pos)
  (if (= delimiter (chr 32))
    (setq str (dwgru-string-replace
                str
                (strcat (chr 32) (chr 32))
                delimiter
              ) ;_ end of dwgru-string-replace
    ) ;_ end of setq
  ) ;_ end of if
  (if (setq pos (vl-string-search delimiter str))
    (cons
      (substr str 1 pos)
      (dwgru-string-to-list
        (substr
          str
          (+ (strlen delimiter) pos 1)
        ) ;_ end of substr
        delimiter
      ) ;_ end of ru-string-pl-string-to-list
    ) ;_ end of cons
    (cons str '())
  ) ;_ end of if
) ;_ end of defun

;;;-------------------------------------------------------------------------
(defun mip_MTEXT_Unformat ( Mtext / text Str )
  ;;;http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=44&TID=20992
  (setq Text "")
  (if (wcmatch (strcase Mtext) "\\PI-#*,\\PT*") ;;_список
    (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
   (while (/= Mtext "")
        (cond
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
            (setq Mtext (substr Mtext 3) Text   (strcat Text Str)))
          ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
	   (setq Mtext (substr Mtext 3)))
          ((wcmatch (strcase (substr Mtext 1 8)) "\\FSYMBOL") ;;;Add VVA remove Symbol
            (setq Mtext (substr Mtext (+ 2 (cond ((vl-string-search "}" Mtext))((vl-string-search ";" Mtext)))))))
          ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
            (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
	  ((wcmatch (strcase (substr mtext 1 4)) "\\PQ[CRJD],\\PX[QI],\\PTZ")  ;;;Add by KPblC
	   (setq mtext (substr mtext (+ 2 (vl-string-search ";" mtext))))
	   )
          ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
            (if (or
		   (zerop (strlen Text))
		   (= " " (substr Text (strlen Text)))
		   (= " " (substr Mtext 3 1)))
               (setq Mtext (substr Mtext 3))
               (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
	  ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
            (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
                  Text  (strcat Text (vl-string-translate "#^\\" "/^\\" Str))
                  Mtext (substr Mtext (+ 4 (strlen Str)))))
          
	  (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))))
  Text)
;;;------------------------------------------------------------------------------------
(defun test (/ ent lst filename file)
  (setq ent (ssget "_x" '((0 . "MTEXT"))))
  (if ent
    (progn
      (setq lst
             (mapcar
               '(lambda (el)
                  ((lambda (txt pt)
                     (cons
                       (cadr txt)
                       (mapcar '+
                               pt
                               (list 0. 0. (read (last txt)))
                       ) ;_ end of mapcar
                     ) ;_ end of cons
                   ) ;_ end of lambda
                    (dwgru-string-to-list (mip_MTEXT_Unformat (car el)) " ")
                    (cdr el)
                  )
                ) ;_ end of lambda
               (vl-sort
                 (mapcar
                   '(lambda (x)
                      ((lambda (a)
                         (cons
                           (cdr (assoc 1 a))
                           (cdr (assoc 10 a))
                         ) ;_ end of cons
                       ) ;_ end of lambda
                        (entget x)
                      )
                    ) ;_ end of lambda
                   (vl-remove-if
                     'listp
                     (mapcar 'cadr (ssnamex ent))
                   ) ;_ end of vl-remove-if
                 ) ;_ end of mapcar
                 (function
                   (lambda (a b)
                     (< (car a) (car b))
                   ) ;_ end of lambda
                 ) ;_ end of function
               ) ;_ end of vl-sort
             ) ;_ end of mapcar
      ) ;_ end of setq
      (setq
        filename
         (strcat (getvar "dwgprefix")
                 (vl-filename-base (getvar "dwgname"))
                 ".csv"
         ) ;_ end of strcat
      ) ;_ end of setq
      (setq file (open filename "w"))
      (mapcar
        (function
          (lambda (l)
            (foreach i l
              (write-line
                (strcat (car i) " " (rtos (cadr i) 2 2))
                file
              ) ;_ end of write-line
            ) ;_ end of foreach
          ) ;_ end of lambda
        ) ;_ end of function
        (mapcar
          (function
            (lambda (x)
              ((lambda (txt pt)
                 (mapcar
                   '(lambda (y)
                      (list
                        (strcat "r" txt "-" (car y))
                        (distance pt (cdr y))
                      ) ;_ end of list
                    ) ;_ end of lambda
                   (vl-remove x lst)
                 ) ;_ end of mapcar
               ) ;_ end of lambda
                (car x)
                (cdr x)
              )
            ) ;_ end of lambda
          ) ;_ end of function
          lst
        ) ;_ end of mapcar
      ) ;_ end of mapcar
      (close file)
      (print (strcat "Файл " filename " успешно создан..."))
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun

;;;запуск  -  (test)

Дима_ · 30.08.2010, 13:24

Цитата:

Сообщение от CB

Т.к. в чертеже нет объектов типа POINT, а есть

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

Макс_Кунгур · 31.08.2010, 12:08

CB, потестировал твой лисп, выдает в csv файле:

Код:

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

r141.2-140.0	31.мар
r141.2-147.5	28.сен
r141.2-142.0	29.16
r141.2-156.5	35.59
r141.2-145.9	31.13
r141.2-132.1	21.52
r141.2-10Э06	57.32
r141.2-11Э06	61.78
r141.2-12Э06	68.4
r141.2-13Э06	77.13
r141.2-14Э06	100.07
r141.2-15Э06	71.66
r141.2-1Э04	397.2
r141.2-2Э04	441.56
r141.2-34	107.41
r141.2-35	дек.27
r141.2-4Э04	391.8
r141.2-5Э04	436.89
r140.0-141.2	31.мар
r140.0-147.5	23.35
r140.0-142.0	дек.71
r140.0-156.5	17.27
r140.0-145.9	33.15
r140.0-132.1	17.47
r140.0-10Э06	28.17
r140.0-11Э06	65.36
r140.0-12Э06	55.11
r140.0-13Э06	73.01
r140.0-14Э06	84.14
r140.0-15Э06	49.29
r140.0-1Э04	398.48
r140.0-2Э04	443.38
r140.0-34	104.8
r140.0-35	22.86
r140.0-4Э04	395.77
r140.0-5Э04	440.95
r147.5-141.2	28.сен
r147.5-140.0	23.35
r147.5-142.0	ноя.29
r147.5-156.5	20.37
r147.5-145.9	окт.77
r147.5-132.1	31.69
r147.5-10Э06	45.45
r147.5-11Э06	45.09
r147.5-12Э06	41.46
r147.5-13Э06	54.05
r147.5-14Э06	72.35
r147.5-15Э06	44.82
r147.5-1Э04	417.16
r147.5-2Э04	462.09
r147.5-34	86.2
r147.5-35	17.июн
r147.5-4Э04	413.54
r147.5-5Э04	458.48
r142.0-141.2	29.16
r142.0-140.0	дек.71
r142.0-147.5	ноя.29
r142.0-156.5	16.77
r142.0-145.9	20.88
r142.0-132.1	23.97
r142.0-10Э06	36.62
r142.0-11Э06	53.07
r142.0-12Э06	44.97
r142.0-13Э06	61.05
r142.0-14Э06	75.33
r142.0-15Э06	43.41
r142.0-1Э04	409.89
r142.0-2Э04	454.77
r142.0-34	93.03
r142.0-35	17.июн
r142.0-4Э04	406.73
r142.0-5Э04	451.86
r156.5-141.2	35.59
r156.5-140.0	17.27
r156.5-147.5	20.37
r156.5-142.0	16.77
r156.5-145.9	30.81
r156.5-132.1	31.июл
r156.5-10Э06	28.82
r156.5-11Э06	64.39
r156.5-12Э06	52.76
r156.5-13Э06	69.87
r156.5-14Э06	80.35
r156.5-15Э06	48.07
r156.5-1Э04	403.71
r156.5-2Э04	449.11
r156.5-34	102.28
r156.5-35	26.86
r156.5-4Э04	401.42
r156.5-5Э04	446.02
r145.9-141.2	31.13
r145.9-140.0	33.15
r145.9-147.5	окт.77
r145.9-142.0	20.88
r145.9-156.5	30.81
r145.9-132.1	38.52
r145.9-10Э06	56
r145.9-11Э06	35.5
r145.9-12Э06	39.23
r145.9-13Э06	47.03
r145.9-14Э06	70.44
r145.9-15Э06	47.77
r145.9-1Э04	425.02
r145.9-2Э04	469.78
r145.9-34	78.51
r145.9-35	20.75
r145.9-4Э04	420.74
r145.9-5Э04	465.72
r132.1-141.2	21.52
r132.1-140.0	17.47
r132.1-147.5	31.69
r132.1-142.0	23.97
r132.1-156.5	31.июл
r132.1-145.9	38.52
r132.1-10Э06	42.09
r132.1-11Э06	69.86
r132.1-12Э06	67.13
r132.1-13Э06	81.75
r132.1-14Э06	97.68
r132.1-15Э06	64.21
r132.1-1Э04	389.7
r132.1-2Э04	434.11
r132.1-34	112.68
r132.1-35	20.фев
r132.1-4Э04	385.69
r132.1-5Э04	431.14
r10Э06-141.2	57.32
r10Э06-140.0	28.17
r10Э06-147.5	45.45
r10Э06-142.0	36.62
r10Э06-156.5	28.82
r10Э06-145.9	56
r10Э06-132.1	42.09
r10Э06-11Э06	85.91
r10Э06-12Э06	65.08
r10Э06-13Э06	87.56
r10Э06-14Э06	87.12
r10Э06-15Э06	50.46
r10Э06-1Э04	392.58
r10Э06-2Э04	438.07
r10Э06-34	118.66
r10Э06-35	49.95
r10Э06-4Э04	392.42
r10Э06-5Э04	437.12
r11Э06-141.2	61.78
r11Э06-140.0	65.36
r11Э06-147.5	45.09
r11Э06-142.0	53.07
r11Э06-156.5	64.39
r11Э06-145.9	35.5
r11Э06-132.1	69.86
r11Э06-10Э06	85.91
r11Э06-12Э06	35
r11Э06-13Э06	21.82
r11Э06-14Э06	57.96
r11Э06-15Э06	55.22
r11Э06-1Э04	458.33
r11Э06-2Э04	502.65
r11Э06-34	46.36
r11Э06-35	53.67
r11Э06-4Э04	453.19
r11Э06-5Э04	498.46
r12Э06-141.2	68.4
r12Э06-140.0	55.11
r12Э06-147.5	41.46
r12Э06-142.0	44.97
r12Э06-156.5	52.76
r12Э06-145.9	39.23
r12Э06-132.1	67.13
r12Э06-10Э06	65.08
r12Э06-11Э06	35
r12Э06-13Э06	25
r12Э06-14Э06	31.85
r12Э06-15Э06	21.84
r12Э06-1Э04	453.25
r12Э06-2Э04	498.2
r12Э06-34	53.79
r12Э06-35	56.55
r12Э06-4Э04	450.85
r12Э06-5Э04	496.03
r13Э06-141.2	77.13
r13Э06-140.0	73.01
r13Э06-147.5	54.05
r13Э06-142.0	61.05
r13Э06-156.5	69.87
r13Э06-145.9	47.03
r13Э06-132.1	81.75
r13Э06-10Э06	87.56
r13Э06-11Э06	21.82
r13Э06-12Э06	25
r13Э06-14Э06	37.82
r13Э06-15Э06	46.65
r13Э06-1Э04	470.73
r13Э06-2Э04	515.48
r13Э06-34	32.44
r13Э06-35	67.02
r13Э06-4Э04	466.95
r13Э06-5Э04	512.11
r14Э06-141.2	100.07
r14Э06-140.0	84.14
r14Э06-147.5	72.35
r14Э06-142.0	75.33
r14Э06-156.5	80.35
r14Э06-145.9	70.44
r14Э06-132.1	97.68
r14Э06-10Э06	87.12
r14Э06-11Э06	57.96
r14Э06-12Э06	31.85
r14Э06-13Э06	37.82
r14Э06-15Э06	37.7
r14Э06-1Э04	479.26
r14Э06-2Э04	524.47
r14Э06-34	47.91
r14Э06-35	88.11
r14Э06-4Э04	478.21
r14Э06-5Э04	523.24
r15Э06-141.2	71.66
r15Э06-140.0	49.29
r15Э06-147.5	44.82
r15Э06-142.0	43.41
r15Э06-156.5	48.07
r15Э06-145.9	47.77
r15Э06-132.1	64.21
r15Э06-10Э06	50.46
r15Э06-11Э06	55.22
r15Э06-12Э06	21.84
r15Э06-13Э06	46.65
r15Э06-14Э06	37.7
r15Э06-1Э04	441.8
r15Э06-2Э04	486.91
r15Э06-34	73.03
r15Э06-35	59.46
r15Э06-4Э04	440.87
r15Э06-5Э04	485.99
r1Э04-141.2	397.2
r1Э04-140.0	398.48
r1Э04-147.5	417.16
r1Э04-142.0	409.89
r1Э04-156.5	403.71
r1Э04-145.9	425.02
r1Э04-132.1	389.7
r1Э04-10Э06	392.58
r1Э04-11Э06	458.33
r1Э04-12Э06	453.25
r1Э04-13Э06	470.73
r1Э04-14Э06	479.26
r1Э04-15Э06	441.8
r1Э04-2Э04	47.35
r1Э04-34	502.29
r1Э04-35	405.03
r1Э04-4Э04	36.41
r1Э04-5Э04	55.73
r2Э04-141.2	441.56
r2Э04-140.0	443.38
r2Э04-147.5	462.09
r2Э04-142.0	454.77
r2Э04-156.5	449.11
r2Э04-145.9	469.78
r2Э04-132.1	434.11
r2Э04-10Э06	438.07
r2Э04-11Э06	502.65
r2Э04-12Э06	498.2
r2Э04-13Э06	515.48
r2Э04-14Э06	524.47
r2Э04-15Э06	486.91
r2Э04-1Э04	47.35
r2Э04-34	546.79
r2Э04-35	449.6
r2Э04-4Э04	56.79
r2Э04-5Э04	36.53
r34-141.2	107.41
r34-140.0	104.8
r34-147.5	86.2
r34-142.0	93.03
r34-156.5	102.28
r34-145.9	78.51
r34-132.1	112.68
r34-10Э06	118.66
r34-11Э06	46.36
r34-12Э06	53.79
r34-13Э06	32.44
r34-14Э06	47.91
r34-15Э06	73.03
r34-1Э04	502.29
r34-2Э04	546.79
r34-35	98.11
r34-4Э04	498.07
r34-5Э04	543.41
r35-141.2	дек.27
r35-140.0	22.86
r35-147.5	17.июн
r35-142.0	17.июн
r35-156.5	26.86
r35-145.9	20.75
r35-132.1	20.фев
r35-10Э06	49.95
r35-11Э06	53.67
r35-12Э06	56.55
r35-13Э06	67.02
r35-14Э06	88.11
r35-15Э06	59.46
r35-1Э04	405.03
r35-2Э04	449.6
r35-34	98.11
r35-4Э04	400.43
r35-5Э04	445.54
r4Э04-141.2	391.8
r4Э04-140.0	395.77
r4Э04-147.5	413.54
r4Э04-142.0	406.73
r4Э04-156.5	401.42
r4Э04-145.9	420.74
r4Э04-132.1	385.69
r4Э04-10Э06	392.42
r4Э04-11Э06	453.19
r4Э04-12Э06	450.85
r4Э04-13Э06	466.95
r4Э04-14Э06	478.21
r4Э04-15Э06	440.87
r4Э04-1Э04	36.41
r4Э04-2Э04	56.79
r4Э04-34	498.07
r4Э04-35	400.43
r4Э04-5Э04	47.34
r5Э04-141.2	436.89
r5Э04-140.0	440.95
r5Э04-147.5	458.48
r5Э04-142.0	451.86
r5Э04-156.5	446.02
r5Э04-145.9	465.72
r5Э04-132.1	431.14
r5Э04-10Э06	437.12
r5Э04-11Э06	498.46
r5Э04-12Э06	496.03
r5Э04-13Э06	512.11
r5Э04-14Э06	523.24
r5Э04-15Э06	485.99
r5Э04-1Э04	55.73
r5Э04-2Э04	36.53
r5Э04-34	543.41
r5Э04-35	445.54
r5Э04-4Э04	47.34

Тут, как я понимаю, нужно что-то лишнее убрать.

Олег (jr.), твой последний вариант подходит,то, что нужно, только у тебя в результирующем файле расстояния начинаютя от наибольшего названия точки, а не от наименьшего расстояния и до самого большого. Можно это переделать?

Кулик Алексей aka kpblc · 31.08.2010, 14:18

Может, просто надо формат ячеек сменить?

Олег (jr.) · 01.09.2010, 12:33

Цитата:

Сообщение от Макс_Кунгур

Олег (jr.), твой последний вариант подходит,то, что нужно, только у тебя в результирующем файле расстояния начинаютя от наибольшего названия точки, а не от наименьшего расстояния и до самого большого. Можно это переделать?

Так пойдет?

~'J'~

Макс_Кунгур · 02.09.2010, 10:50

Олег (jr.), у тебя сейчас данные стоят с наименьшего НОМЕРА по наибольший. А мне надо с наименьшего РАССТОЯНИЯ по наибольшее. Т.е., у тебя сейчас выходит:

Point: 1Э04
2Э04 45.2358
4Э04 35.007
5Э04 55.5601
7Э06 397.179
9гЭ06 389.487
......................

А надо:

Point: 1Э04
4Э04 35.007
2Э04 45.2358
5Э04 55.5601
9гЭ06 389.487
7Э06 397.179
......................

Олег (jr.) · 02.09.2010, 12:50

Цитата:

Сообщение от Макс_Кунгур

Олег (jr.), у тебя сейчас данные стоят с наименьшего НОМЕРА по наибольший. А мне надо с наименьшего РАССТОЯНИЯ по наибольшее. Т.е., у тебя сейчас выходит:

Point: 1Э04
2Э04 45.2358
4Э04 35.007
5Э04 55.5601
7Э06 397.179
9гЭ06 389.487
......................

А надо:

Point: 1Э04
4Э04 35.007
2Э04 45.2358
5Э04 55.5601
9гЭ06 389.487
7Э06 397.179
......................

Понял

Макс_Кунгур · 02.09.2010, 13:08

Олег (jr.), проверил твое последнее творение. То что нужно, огромное спасибо! Скажи, у тебя в подсчете координата z присутствует или нет? Потому что, мне обязательно нужно, чтобы она присутствовала!!!

CB, выкладываю файл, на котором тестировал твой лисп.

Олег (jr.) · 02.09.2010, 17:10

Цитата:

Сообщение от Макс_Кунгур

Олег (jr.), проверил твое последнее творение. То что нужно, огромное спасибо! Скажи, у тебя в подсчете координата z присутствует или нет? Потому что, мне обязательно нужно, чтобы она присутствовала!!!

CB, выкладываю файл, на котором тестировал твой лисп.

Для определения расстояний используется стандартная функция distance
она учитывает Z координату если точка 3d, так что все пучком

~'J'~

CB · 02.09.2010, 17:40

>Макс_Кунгур

Цитата:

CB, выкладываю файл, на котором тестировал твой лисп.

Врешь ты все...
Где в этом файле
r141.2-140.0 31.мар
r141.2-147.5 28.сен
и т.д.
Да и выше у тебя получалась ошибка {\\FTIMES
Значит какому-то Mtext'у присвоен текстовый стиль TIMES...
Да и вообще, наверняка в файле присутствует Мтекст, не имеющий отношения к точкам, а его нужно отфильтровать в ssget'е...
Во всяком случае проверяй слегка обновленный вариант, тестируемый на том чертеже, что ты выложил (функции dwgru-string-replace, dwgru-string-to-list, mip_MTEXT_Unformat - без изменений):

Код:

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

(defun test (/ ent lst filename file)
  (setq ent (ssget "_x" '((0 . "MTEXT"))))
  (if ent
    (progn
      (setq lst
             (mapcar
               '(lambda (el)
                  (cons
                    (caar el)
                    (mapcar '+
                            (cdr el)
                            (list 0. 0. (read (cadar el)))
                    ) ;_ end of mapcar
                  ) ;_ end of cons
                ) ;_ end of lambda
               (vl-sort
                 (mapcar
                   '(lambda (x)
                      ((lambda (a)
                         (cons
                           ((lambda (b)
                              (if (> (length b) 2)
                                (cdr b)
                                b
                              ) ;_ end of if
                            ) ;_ end of lambda
                             (dwgru-string-to-list
                               (mip_MTEXT_Unformat
                                 (cdr (assoc 1 a))
                               ) ;_ end of mip_MTEXT_Unformat
                               " "
                             ) ;_ end of dwgru-string-to-list
                           )
                           (cdr (assoc 10 a))
                         ) ;_ end of cons
                       ) ;_ end of lambda
                        (entget x)
                      )
                    ) ;_ end of lambda
                   (vl-remove-if
                     'listp
                     (mapcar 'cadr (ssnamex ent))
                   ) ;_ end of vl-remove-if
                 ) ;_ end of mapcar
                 (function
                   (lambda (a b)
                     (< (caar a) (caar b))
                   ) ;_ end of lambda
                 ) ;_ end of function
               ) ;_ end of vl-sort
             ) ;_ end of mapcar
      ) ;_ end of setq
      (setq
        filename
         (strcat (getvar "dwgprefix")
                 (vl-filename-base (getvar "dwgname"))
                 ".csv"
         ) ;_ end of strcat
      ) ;_ end of setq
      (setq file (open filename "w"))
      (mapcar
        (function
          (lambda (l)
            (write-line
              (strcat "     ТОЧКА " (car l))
              file
            ) ;_ end of write-line
            (foreach i (cadr l)
              (write-line
                (strcat (car i)
                        "    "
                        (rtos (cadr i) 2 2)
                ) ;_ end of strcat
                file
              ) ;_ end of write-line
            ) ;_ end of foreach
          ) ;_ end of lambda
        ) ;_ end of function
        (mapcar
          (function
            (lambda (x)
              ((lambda (txt pt)
                 (list
                   txt
                   (vl-sort
                     (mapcar
                       '(lambda (y)
                          (list
                            (strcat txt " -> " (car y))
                            (distance pt (cdr y))
                          ) ;_ end of list
                        ) ;_ end of lambda
                       (vl-remove x lst)
                     ) ;_ end of mapcar
                     (function
                       (lambda (a b)
                         (< (cadr a) (cadr b))
                       ) ;_ end of lambda
                     ) ;_ end of function
                   ) ;_ end of vl-sort
                 ) ;_ end of list
               ) ;_ end of lambda
                (car x)
                (cdr x)
              )
            ) ;_ end of lambda
          ) ;_ end of function
          lst
        ) ;_ end of mapcar
      ) ;_ end of mapcar
      (close file)
      (print (strcat "Файл " filename " успешно создан..."))
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun

Дима_ · 02.09.2010, 18:15

Цитата:

Сообщение от Олег (jr.)

Для определения расстояний используется стандартная функция distance
она учитывает Z координату если точка 3d, так что все пучком
~'J'~

по крайней мере в приложенном примере точки были двухмерными а координата z должна была "тягаться" из текста (собственно почему я и начал говорить - что здесь проще вобще рисунком не пользоваться, а использовать исходный текстовой файл) - посему результат у тебя без учета z - неверный.

Олег (jr.) · 02.09.2010, 18:41

Цитата:

Сообщение от Дима_

- посему результат у тебя без учета z - неверный.

Жжешь,
Кароч, мне твое мнение по барабану
Юзер без тебя разберется

Дима_ · 02.09.2010, 18:56

Цитата:

Сообщение от Олег (jr.)

Жжешь,
Кароч, мне твое мнение по барабану
Юзер без тебя разберется

рано или поздно - безусловно - только боюсь, не последний раз ты код переписываешь

Макс_Кунгур · 03.09.2010, 08:18

CB, потестировал твой последний лисп, вроде бы все хорошо, но твои расстояния не совпадают с расстояниями Олег (jr.). Н-р: у тебя 10Э06 -> 9гЭ06 42.09, а у Олег (jr.) - 38.3214. По твоему лиспу у меня такой результат получается:

ТОЧКА 10Э06
10Э06 -> 9Э05 28.17
10Э06 -> 9бЭ06 28.82
10Э06 -> 9аЭ06 36.62
10Э06 -> 9гЭ06 42.09
10Э06 -> 9Э06 45.45
10Э06 -> 35 49.95
10Э06 -> 15Э06 50.46
10Э06 -> 9вЭ06 56
10Э06 -> 7Э06 57.32
10Э06 -> 12Э06 65.08
10Э06 -> 11Э06 85.91
10Э06 -> 14Э06 87.12
10Э06 -> 13Э06 87.56
10Э06 -> 34 118.66
10Э06 -> 4Э04 392.42
10Э06 -> 1Э04 392.58
10Э06 -> 5Э04 437.12
10Э06 -> 2Э04 438.07
ТОЧКА 11Э06
11Э06 -> 13Э06 21.82
11Э06 -> 12Э06 35
11Э06 -> 9вЭ06 35.5
11Э06 -> 9Э06 45.09
11Э06 -> 34 46.36
11Э06 -> 9аЭ06 53.07
11Э06 -> 35 53.67
11Э06 -> 15Э06 55.22
11Э06 -> 14Э06 57.96
11Э06 -> 7Э06 61.78
11Э06 -> 9бЭ06 64.39
11Э06 -> 9Э05 65.36
11Э06 -> 9гЭ06 69.86
11Э06 -> 10Э06 85.91
11Э06 -> 4Э04 453.19
11Э06 -> 1Э04 458.33
11Э06 -> 5Э04 498.46
11Э06 -> 2Э04 502.65
.................................
Вывод мне нравится, только лишь бы расстояния правильные были. Но я проверить это не могу, потому что кроме координат точек у меня данных нет. У тебя координата z учитывается в нахождении расстояния?
И еще вопрос: если у меня на рисунке в дальнейшем будут построены границы и поверхности по этим точкам с изолиниями, программа сможет посчитать расстояния?

CB · 03.09.2010, 09:15

Выводы делай сам...

Код:

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

Command: (entget (car (entsel)))
Select object: ((-1 . <Entity name: 40072818>) (0 . "MTEXT") (330 . <Entity 
name: 40070cf8>) (5 . "26B") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . 
"0") (62 . 1) (100 . "AcDbMText") (10 483912.0 6.37368e+006 0.0) (40 . 2.0) (41 
. 0.0) (71 . 4) (72 . 5) (1 . "№ 10Э06\\P\\P149.5") (7 . "Standard") (210 0.0 
0.0 1.0) (11 1.0 0.0 0.0) (42 . 11.6667) (43 . 8.66667) (50 . 0.0) (73 . 1) (44 
. 1.0))

Command: (entget (car (entsel)))
Select object: ((-1 . <Entity name: 400727b8>) (0 . "MTEXT") (330 . <Entity 
name: 40070cf8>) (5 . "267") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . 
"0") (62 . 1) (100 . "AcDbMText") (10 483918.0 6.37364e+006 0.0) (40 . 2.0) (41 
. 0.0) (71 . 4) (72 . 5) (1 . "9гЭ06\\P\\P132.1") (7 . "Standard") (210 0.0 0.0 
1.0) (11 1.0 0.0 0.0) (42 . 8.66667) (43 . 8.66667) (50 . 0.0) (73 . 1) (44 . 
1.0))

(setq pt1 (getpoint "\nМтекст 10Э06: "))
=> (483912.0 6.37368e+006 0.0)

(setq pt2 (getpoint "\nМтекст 9гЭ06: "))
=> (483918.0 6.37364e+006 0.0)

(setq a (distance pt1 pt2))
=> 38.3214

(setq b (- 149.5 132.1))
=> 17.4

(sqrt (+ (* a a) (* b b)))
=> 42.0867

(rtos 42.0867 2 2)
=> "42.09"

Елпанов Евгений · 03.09.2010, 09:25

Макс_Кунгур, почитал тему, стало очень любопытно...
Зачем все эти вычисления? Точнее, что нужно в конце?
Может сразу нужно вычислить триангуляцию, например по Делоне или полигоны Вороного? По сути, запрошенные вычисления - направленный граф, те. вычисления, не зависимо от конечной задачи, избыточны.
В предложенном задании, надо создать таблицу расстояний от точки до всех остальных и таблиц по количеству точек, сортировку в таблицах, сделать по расстоянию до остальных. Очень похоже на данные по триангуляции. Я упомянул о графе не зря - значительно быстрее будет вычислить в первой таблице расстояние от первой точки до всех, кроме первой, во второй, от второй до всех, кроме первой и второй, в третьей, от третьей до всех, кроме первой, второй и третьей. Вычислений меньше, данных столько же, использовать в будущем, еще проще.

Но если говорить о триангуляции, то можно вообще не вычислять расстояние от точки до всех, достаточно сначала отсортировать все облако точек, а потом вычислять это расстояние от каждой до трех...

Удачи!

Олег (jr.) · 03.09.2010, 09:42

Цитата:

Сообщение от Елпанов Евгений

Макс_Кунгур, почитал тему, стало очень любопытно...
Зачем все эти вычисления? Точнее, что нужно в конце?
Может сразу нужно вычислить триангуляцию, например по Делоне или полигоны Вороного? По сути, запрошенные вычисления - направленный граф, те. вычисления, не зависимо от конечной задачи, избыточны.
В предложенном задании, надо создать таблицу расстояний от точки до всех остальных и таблиц по количеству точек, сортировку в таблицах, сделать по расстоянию до остальных. Очень похоже на данные по триангуляции. Я упомянул о графе не зря - значительно быстрее будет вычислить в первой таблице расстояние от первой точки до всех, кроме первой, во второй, от второй до всех, кроме первой и второй, в третьей, от третьей до всех, кроме первой, второй и третьей. Вычислений меньше, данных столько же, использовать в будущем, еще проще.

Но если говорить о триангуляции, то можно вообще не вычислять расстояние от точки до всех, достаточно сначала отсортировать все облако точек, а потом вычислять это расстояние от каждой до трех...

Удачи!

Я еще не удивлюсь как вдруг выяснится, что координата Z
хранится во второй строчке Mtext'a
Просто удивительно, когда человек имеет такое
количество постов на форуме, а вопросы задавать как-то
не очень...
И вот целая толпа уже неделю решает плевую проблему...
Ну...ваще

CB · 03.09.2010, 09:55

А чего удивляться - про это уже было сказано...

Цитата:

Сообщение от CB

О как!
Оказывается здесь точки в пространстве, а не в плоскости...

1 484304.0 6373696.0 144.9 1Э04
2 484349.2 6373694.2 130.9 2Э04
3 484303.3 6373661.0 134.9 4Э04
4 484348.4 6373662.6 149.2 5Э04

Цитата:

Сообщение от Макс_Кунгур

Извините, забыл сказать, что координату z (т.е. 3-й столбец 144,9 130,9 134.9 149.2) надо ОБЯЗАТЕЛЬНО в расчеты брать!!!

Олег (jr.) · 03.09.2010, 10:02

Цитата:

Сообщение от CB

А чего удивляться - про это уже было сказано...

Мне лично это сказано не было и я умываюсь отседа

Макс_Кунгур · 03.09.2010, 12:44

CB, все понял. спасибо огромное. твой лисп мне очень помог.

Олег (jr.) · 03.09.2010, 22:01

С учетом значений текста как координаты Z

~'J'~

23.08.2010, 09:03		#1
Нахождение расстояния между точками на чертеже Макс_Кунгур Регистрация: 10.12.2008 Сообщений: 122 Добрый день! Столкнулся с такой задачей. Есть чертеж с множеством точек (около 100). Нужно при помощи языка LISP найти расстояния от одной точки, которую ты укажешь на чертеже, до всех остальных точек. Результат с расстояниями должен вывестись в текстовый файл или в таблицу Excel. Как найти расстояние между 2-мя точками, я знаю. А вот как до всех точек, пока не разобрался. Подскажите, пожалуйста, как решить данную задачу.
Просмотров: 18161

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Расстояния между компенсаторами тепловых сетей	proekt_mep	Отопление	10	29.05.2012 14:17
Определение высот рельефа по близлежащим точкам	dextron3	Программирование	21	10.11.2011 13:14
Расстояние между проемами в соседних пожарных отсеках (блокированные жилые дома)	Koliabek	Пожарная безопасность	11	13.05.2009 11:17
Расстояние между видами на чертеже	Сеченов	Разное	14	09.02.2009 15:50
Как определить расстояние между 2 точками по spline?	Хотабыч	Программирование	5	22.01.2006 15:33

	Реклама i